* * *

Author Topic: Assigning methods to events in runtime  (Read 631 times)

bdexterholland

  • Jr. Member
  • **
  • Posts: 56
  • uh?
Assigning methods to events in runtime
« on: January 04, 2018, 10:07:27 pm »
Hi there!

I'm facing a problem that 'til now I can't find a good anwser for me.

Trying to assign a method to a TBitBtn.OnClick makes fpc raise this error:
Quote
unt_dialogo.pp(204,25) Error: Incompatible types: got "<procedure variable type of procedure(const TObject) of object;Register>" expected "<procedure variable type of procedure(TObject) of object;Register>"

What am I doing wrong?

Thanks for the help...

my code:
Code: Pascal  [Select]
  1. unit unt_dialogo;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. type
  8.   TTipoDialogo = (dtInformacao, dtAviso, dtErro, dtPergunta);
  9.   TRetornoDialogo = (rdOK, rdSim, rdNao, rdCancelar);
  10.  
  11. function ShowDialog(const AMessage: string;
  12.   const ATipoDialog: TTipoDialogo = dtInformacao;
  13.   const Login: string = ''): TRetornoDialogo;
  14.  
  15. implementation
  16.  
  17.  
  18.  
  19. uses
  20.   Forms, Graphics, Classes, Controls, Buttons, StdCtrls, ExtCtrls, SysUtils;
  21.  
  22. const
  23.   _PN_TITULO: integer = $00DF9254;
  24.   _PN_CORPO: integer = $00F9F9F9;
  25.   _PN_RODAPE: integer = $00EFEFEF;
  26.   _LB_TITULO: integer = $00FFFFFF;
  27.  
  28. type
  29.  
  30.   { TDialogForm }
  31.  
  32.   TDialogForm = class(TForm)
  33.   private
  34.     _Type: TTipoDialogo;
  35.     _Message: string;
  36.     _User: string;
  37.     _System: string;
  38.     _CodigoErro: string;
  39.  
  40.     _iconeDialogo: TImage;
  41.     _headerPanel: TPanel;
  42.     _bodyPanel: TPanel;
  43.     _footerPanel: TPanel;
  44.     _titleLabel: TLabel;
  45.     _messageLabel: TLabel;
  46.     _okButton: TBitBtn;
  47.     _cancelButton: TBitBtn;
  48.     _yesButton: TBitBtn;
  49.     _noButton: TBitBtn;
  50.  
  51.     procedure setYesNoButtons;
  52.     procedure setOkButton;
  53.     procedure setOkCancelButtons;
  54.  
  55.     procedure setDTInformacao;
  56.     procedure setDTAViso;
  57.     procedure setDTErro;
  58.     procedure setDTPergunta;
  59.  
  60.     procedure PYesButton(const Sender: TObject);
  61.     procedure PNoButton(const Sender: TObject);
  62.     procedure PCancelButton(const Sender: TObject);
  63.     procedure POkButton(const Sender: TObject);
  64.  
  65.   public
  66.     constructor Create(const ASistema: string = 'NAO INFORMADO');
  67.     function ShowModal(const Atipo: TTipoDialogo; const AMensagem: string; const AUsuario: string = 'NÃO INFORMADO'): TModalResult;
  68.                 procedure InicializarSubobjetos;
  69.   end;
  70.  
  71. { TDialogForm }
  72. var
  73.   DialogForm: TDialogForm;
  74.  
  75. function ShowDialog(const AMessage: string; const ATipoDialog: TTipoDialogo;
  76.   const Login: string): TRetornoDialogo;
  77. begin
  78.         if not(Assigned(DialogForm)) then
  79.     begin
  80.             DialogForm := TDialogForm.CreateNew(Nil);
  81.       DialogForm.InicializarSubobjetos;
  82.     end;
  83.  
  84.   case DialogForm.ShowModal(ATipoDialog, AMessage, Login) of
  85.     mrYes: Result := rdSim;
  86.     mrNo: Result := rdNao;
  87.     mrCancel: Result := rdCancelar;
  88.     else
  89.       Result := rdOK;
  90.   end;
  91. end;
  92.  
  93. procedure TDialogForm.setYesNoButtons;
  94. begin
  95.   _yesButton.Visible := True;
  96.   _noButton.Visible := True;
  97.   _cancelButton.Visible := False;
  98.   _okButton.Visible := False;
  99. end;
  100.  
  101. procedure TDialogForm.setOkButton;
  102. begin
  103.   _yesButton.Visible := False;
  104.   _noButton.Visible := False;
  105.   _cancelButton.Visible := False;
  106.   _okButton.Visible := True;
  107. end;
  108.  
  109. procedure TDialogForm.setOkCancelButtons;
  110. begin
  111.   _yesButton.Visible := False;
  112.   _noButton.Visible := False;
  113.   _cancelButton.Visible := True;
  114.   _okButton.Visible := True;
  115. end;
  116.  
  117. constructor TDialogForm.Create(const ASistema: string);
  118. begin
  119.   Self._System := ASistema;
  120. end;
  121.  
  122. function TDialogForm.ShowModal(const Atipo: TTipoDialogo; const AMensagem: string;
  123.   const AUsuario: string): TModalResult;
  124. begin
  125.   case Atipo of
  126.     dtInformacao: Self.setDTInformacao;
  127.     dtAviso: Self.setDTAViso;
  128.     dtErro: Self.setDTErro;
  129.     dtPergunta: Self.setDTPergunta;
  130.   end;
  131.  
  132.   Self._Message := AMensagem;
  133.   Self._messageLabel.Caption := AMensagem;
  134.   Self._User := AUsuario;
  135.  
  136.   Result := inherited ShowModal;
  137.  
  138.   Self._Message := '';
  139.   Self._User := '';
  140.  
  141. end;
  142.  
  143. procedure TDialogForm.InicializarSubobjetos;
  144. begin
  145.   {$REGION 'Formulário'}
  146.   Self.Width := 450;
  147.   Self.Height := 300;
  148.   Self.Position := poScreenCenter;
  149.   Self.BorderIcons := [];
  150.   Self.BorderStyle := bsSingle;
  151.   Self.Font.Size := 12;
  152. {$ENDREGION}
  153.  
  154. {$REGION 'Paineis'}
  155.   _headerPanel := TPanel.Create(Self);
  156.         _headerPanel.Parent := Self;
  157.   _headerPanel.Align := alTop;
  158.   _headerPanel.Color := _PN_TITULO;
  159.   _headerPanel.BevelOuter := bvNone;
  160.   _headerPanel.BorderWidth := 10;
  161.   _headerPanel.Height := 50;
  162.  
  163.   _bodyPanel := TPanel.Create(Self);
  164.   _bodyPanel.Parent := Self;
  165.   _bodyPanel.Align := alClient;
  166.   _bodyPanel.Color := _PN_CORPO;
  167.   _bodyPanel.BevelOuter := bvNone;
  168.   _bodyPanel.BorderWidth := 10;
  169.  
  170.   _footerPanel := TPanel.Create(Self);
  171.   _footerPanel.Parent := Self;
  172.   _footerPanel.Align := alBottom;
  173.   _footerPanel.Color := _PN_RODAPE;
  174.   _footerPanel.BevelOuter := bvNone;
  175.   _footerPanel.BorderWidth := 10;
  176.   _footerPanel.Height := 55;
  177. {$ENDREGION}
  178.  
  179. {$REGION 'Labels'}
  180.   _titleLabel := TLabel.Create(_headerPanel);
  181.   _titleLabel.Parent := _headerPanel;
  182.   _titleLabel.Font.Size := 16;
  183.   _titleLabel.Font.Color := clWhite;
  184.   _titleLabel.Align := alClient;
  185.   _titleLabel.Layout := tlCenter;
  186.   _titleLabel.Caption := 'Título da janela';
  187.   _titleLabel.BorderSpacing.Left := 10;
  188.  
  189.   _messageLabel := TLabel.Create(_bodyPanel);
  190.   _messageLabel.Parent := _bodyPanel;
  191.   _messageLabel.Font.Color := clWindowText;
  192.   _messageLabel.Align := alLeft;
  193.   _messageLabel.Layout := tlTop;
  194.   _messageLabel.Caption := 'Texto da mensagem aparecerá aqui...';
  195. {$ENDREGION}
  196.  
  197. {$REGION 'Botões'}
  198.   {TODO: Carregar ícones dos botões }
  199.   _yesButton := TBitBtn.Create(Self);
  200.         _yesButton.Parent := _footerPanel;
  201.   _yesButton.Align := alRight;
  202.   _yesButton.Caption := 'Sim';
  203.   _yesButton.Width := 100;
  204.   _yesButton.OnClick := @PYesButton;
  205.   _yesButton.BorderSpacing.Left := 10;
  206.  
  207.   _noButton := TBitBtn.Create(Self);
  208.   _noButton.Parent := _footerPanel;
  209.   _noButton.Align := alRight;
  210.   _noButton.Caption := 'Não';
  211.   _noButton.Width := 100;
  212.   _noButton.OnClick := @PNoButton;
  213.   _noButton.BorderSpacing.Left := 10;
  214.  
  215.   _okButton := TBitBtn.Create(Self);
  216.   _okButton.Parent := _footerPanel;
  217.   _okButton.Align := alRight;
  218.   _okButton.Caption := 'OK';
  219.   _okButton.Width := 100;
  220.   _okButton.OnClick := @POkButton;
  221.   _okButton.BorderSpacing.Left := 10;
  222.  
  223.   _cancelButton := TBitBtn.Create(Self);
  224.   _cancelButton.Parent := _footerPanel;
  225.   _cancelButton.Align := alRight;
  226.   _cancelButton.Caption := 'Cancelar';
  227.   _cancelButton.Width := 100;
  228.   _cancelButton.OnClick := @PCancelButton;
  229.   _cancelButton.BorderSpacing.Left := 10;
  230. {$ENDREGION}
  231.  
  232. {$REGION 'Icone da janela'}
  233.   {TODO: Adicionar ícone de acordo com o tipo de diálogo}
  234.   _iconeDialogo := TImage.Create(_headerPanel);
  235.   _iconeDialogo.Parent := _headerPanel;
  236.   _iconeDialogo.Align := alLeft;
  237.   _iconeDialogo.Width := 32;
  238. {$ENDREGION}
  239. end;
  240.  
  241. procedure TDialogForm.setDTInformacao;
  242. begin
  243.   Self._titleLabel.Caption := 'Informação';
  244.   Self.Caption := Self._titleLabel.Caption;
  245.   Self.setOkButton;
  246. end;
  247.  
  248. procedure TDialogForm.setDTAViso;
  249. begin
  250.   Self._titleLabel.Caption := 'Aviso';
  251.   Self.Caption := Self._titleLabel.Caption;
  252.   Self.setOkButton;
  253. end;
  254.  
  255. procedure TDialogForm.setDTErro;
  256. begin
  257.   Self._titleLabel.Caption := 'Erro';
  258.   Self.Caption := Self._titleLabel.Caption;
  259.   Self.setOkButton;
  260. end;
  261.  
  262. procedure TDialogForm.setDTPergunta;
  263. begin
  264.   Self._titleLabel.Caption := 'Pergunta';
  265.   Self.Caption := Self._titleLabel.Caption;
  266.   Self.setYesNoButtons;
  267. end;
  268.  
  269. procedure TDialogForm.PYesButton(const Sender: TObject);
  270. begin
  271.   Self.ModalResult := mrYes;
  272. end;
  273.  
  274. procedure TDialogForm.PNoButton(const Sender: TObject);
  275. begin
  276.   Self.ModalResult := mrNo;
  277. end;
  278.  
  279. procedure TDialogForm.PCancelButton(const Sender: TObject);
  280. begin
  281.   Self.ModalResult := mrCancel;
  282. end;
  283.  
  284. procedure TDialogForm.POkButton(const Sender: TObject);
  285. begin
  286.   Self.ModalResult := mrOk;
  287. end;
  288.  
  289. finalization
  290.   DialogForm.Free;
  291.  
  292. end.
[sleep .....]

Thaddy

  • Hero Member
  • *****
  • Posts: 5798
Re: Assigning methods to events in runtime
« Reply #1 on: January 04, 2018, 10:15:30 pm »
Code: Pascal  [Select]
  1. function ShowDialog(const AMessage: string;
  2.   const ATipoDialog: TTipoDialogo = dtInformacao;
  3.   const Login: string = ''): TRetornoDialogo of object;

Object methods have a hidden self parameter.

In this particular case I would write a type helper.
« Last Edit: January 04, 2018, 10:17:59 pm by Thaddy »
recommends {$macro on}{$define Silly:=ObjFpc}

Blaazen

  • Hero Member
  • *****
  • Posts: 2510
  • POKE 54296,15
    • Eye-Candy Controls
Re: Assigning methods to events in runtime
« Reply #2 on: January 04, 2018, 10:17:32 pm »
Code: Pascal  [Select]
  1.  
  2.     procedure PYesButton(const Sender: TObject);
  3.     procedure PNoButton(const Sender: TObject);
  4.     procedure PCancelButton(const Sender: TObject);
  5.     procedure POkButton(const Sender: TObject);
AFAIK const should not be there.
Lazarus 1.9.0 r57500 FPC 3.0.4 x86_64-linux-qt Chakra, Qt 4.8.7, Plasma 5.11.4
Lazarus 1.8.0 r56594 FPC 3.0.4 i386-win32-win32/win64 Wine 3.2

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

Thaddy

  • Hero Member
  • *****
  • Posts: 5798
Re: Assigning methods to events in runtime
« Reply #3 on: January 04, 2018, 10:18:40 pm »
That's safe enough. It is of object that really matters. Never mind I was wrong.
« Last Edit: January 04, 2018, 10:22:56 pm by Thaddy »
recommends {$macro on}{$define Silly:=ObjFpc}

bdexterholland

  • Jr. Member
  • **
  • Posts: 56
  • uh?
Re: Assigning methods to events in runtime
« Reply #4 on: January 04, 2018, 10:20:53 pm »
Code: Pascal  [Select]
  1. function ShowDialog(const AMessage: string;
  2.   const ATipoDialog: TTipoDialogo = dtInformacao;
  3.   const Login: string = ''): TRetornoDialogo of object;

Object methods have a hidden self parameter.

In this particular case I would write a type helper.

thanks for trying but the error is not in that header. Is on line 204, and it repeats on lines 212, 220 and 228.
[sleep .....]

bdexterholland

  • Jr. Member
  • **
  • Posts: 56
  • uh?
Re: Assigning methods to events in runtime
« Reply #5 on: January 04, 2018, 10:22:25 pm »
Code: Pascal  [Select]
  1.  
  2.     procedure PYesButton(const Sender: TObject);
  3.     procedure PNoButton(const Sender: TObject);
  4.     procedure PCancelButton(const Sender: TObject);
  5.     procedure POkButton(const Sender: TObject);
AFAIK const should not be there.

bulleye!

Thanks!!!!
[sleep .....]

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus