0

Explico, tenho o FModelo1 que tem varias funções padrão, dentre elas tenho a criação do evento OnCellClick de um DBGrid que é herdada para todos os formularios criados a partir do FModelo1, funciona beleza, agora preciso por exemplo que o FClientes que é herdado do FModelo1 tenha além da herança do evento OnCellClick do FModelo1 o seu proprio evento CellClick adicionado quando clicado.

Isso não esta ocorrendo porque o evento está sendo substituido pelo evento do FModelo1

Vou tentar colocar parte do código:

No OnShow do FModelo1 eu faço varias verificações uma delas é se exite DBGrid no Form, encontrando um DBGrid eu substituo alguns eventos dentre eles o CellClick como abixo:

...
TDBGrid(Components[i]).OnCellClick := DBGridCellClick;
...

DBGridCellClick é uma Procedure com uma rotinha padrão para todos os forms:

procedure TFmodelo1.DBGridCellClick(Column: TColumn);
begin
  if Column.PickList.Count > 0 then
  begin
    keybd_event(VK_F2, 0, 0, 0);
    keybd_event(VK_F2, 0, KEYEVENTF_KEYUP, 0);
    keybd_event(VK_MENU, 0, 0, 0);
    keybd_event(VK_DOWN, 0, 0, 0);
    keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
    keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
  end;
end;

La no FClientes tem seu proprio CellClick com sua rotina em particular, eu consigo anular no OnShow a procedure do FModelo1 com a linha:

JvDBUltimGridClientes.OnCellClick := JvDBUltimGridClientesCellClick;

Porem eu queria a grosso modo que fosse algo assim:

DBGridClientes.OnCellClick := DBGridCellClick + DBGridClientesCellClick;

Ou seja ele pegaria os eventos do FModelo1 + FClientes

2
  • Poste seu código para ter uma resposta mais completa. 12/04/2018 às 16:37
  • Vou tentar colocar parte, pois é meio complexo
    – Marcelo
    12/04/2018 às 16:40

2 Respostas 2

3

Nesse caso você terá que sobrepor o evento da classe TFModelo1 na TFClientes, ficaria mais ou menos assim:

type
  TFClientes = class(TFModelo1)
  private
    FOnCellClick: TDBGridClickEvent;
    procedure SetOnCellClick(const Value: TDBGridClickEvent);

    procedure OnCellClick(Column: TColumn);
  public
    property OnCellClick: TDBGridClickEvent read FOnCellClick write SetOnCellClick; // Propriedade onde estará a procedure a ser executada

    constructor Create; reintroduce;
  end;

implementation

{ TFClientes }

constructor TFClientes.Create;
begin
  //Ao construir, você já passa a procedure desta classe pra ser executada
  inherited OnCellClick := FOnCellClick;
end;

procedure TFClientes.OnCellClick(Column: TColumn);
begin
  //Se foi passada alguma procedure para o OnCellClick, execute
  if (Assigned(FOnCellClick)) then
    FOnCellClick(Column);
end;

procedure TFClientes.SetOnCellClick(const Value: TDBGridClickEvent);
begin
  FOnCellClick := Value;
end;
6
  • +1 pela resposta correta e ter utilizado o reintroduce no constructoor 12/04/2018 às 17:26
  • nem todo mundo utiliza, o que gera Warning e acaba funcionando indevidamente! 12/04/2018 às 17:46
  • @Roberto de Campos, entendi, agora existe como fazer o Modelo adicionar os eventos nos formulários herdados? Imagine que tenho N formulários criados com o FModelo1, eu teria que entrar em um por um pra adicionar essa rotina, se eu conseguir tratar isso lá no FModelo1 ele conseguiria adicionar os eventos herdados em todos os seus dependentes, não sei se fui claro.
    – Marcelo
    12/04/2018 às 17:51
  • Nunca fiz isso, mas acredito que se você fizer um array de procedures, você pode varrer e executar. Não sei se é a melhor saida para isso. 12/04/2018 às 17:54
  • Ou você também pode criar um OnCellClickExtra por exemplo. 12/04/2018 às 17:56
1

Você pode chamar o handler de evento do ancestral:

procedure TFClientes.OnCellClick(Column: TColumn); begin inherited; //executa OnCellClick do FModelo1 ... //seu código do FClientes aqui end;

1
  • Obrigado pela resposta Ricardo, mas acontece que o evento é criado de maneira dinâmica, não existe até então DBGrid la no FModelo1 então o evento não é herdado e sim substituído.
    – Marcelo
    13/04/2018 às 14:56

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .