Posso criar em evento onClick em tempo de execução para um TLabel

Delphi

23/04/2015

Posso criar em evento onClick em tempo de execução, para um TLabel também criado em tempo de execução? meu programa criar uma serie de TLabels em tempo de execução, posso referencia-los todos a um mesmo OnClick, sem precisar fazer o mesmo para cada um deles?
Novice Php

Novice Php

Curtidas 0

Melhor post

Renato Rubinho

Renato Rubinho

24/04/2015

Pode.

// Procedure:
procedure SeuForm.Label1Click(Sender: TObject);
begin
  ShowMessage(TLabel(Sender).Caption);
end;

// Atribuição
  Label1.OnClick := SeuForm.Label1Click;
GOSTEI 2

Mais Respostas

Rodrigo Martins

Rodrigo Martins

23/04/2015

Explique melhor , mas acredito que possa sim
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Estou tentando adicionar ao evento onClick de alguns TLabel's criados em execução num TPanel, um procedure SomatorioClick!
Uses
........
Type
.........
procedure Alterar(Sender: TObject);
procedure SomatorioClick(Sender: TObject);



procedure Tfrm01.SomatorioClick(Sender: TObject);

var
  aux,linha,coluna:integer;

begin
  linha:=StrToInt(copy(TLabel(Sender).Name,4,1));
  coluna:=StrToInt(copy(TLabel(Sender).Name,5,1));
  aux:=StrToInt(TLabel(Sender).Caption);



procedure Tfrm01.Alterar(Sender: TObject);

var
  ind:integer;
 
begin
  for ind:=pnlTriangulo.ComponentCount-1 downto 0 do
    begin
      if (pnlTriangulo.Components[ind] is TLabel) then
     (pnlTriangulo.Components[ind] as TLabel).onClick:=SomatorioClick;
   end;
end;


da erro no: ... onClick:=SomatorioClick; "numero errado de parametros especificados", onde estou errando?
GOSTEI 0
Novice Php

Novice Php

23/04/2015

também adicionei um onMouseMove, apresenta o mesmo erro..
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Não entendo porque ocorre o erro.
Tenta apontar a procedure indicando o Form.

(pnlTriangulo.Components[ind] as TLabel).onClick := frm01.SomatorioClick;
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Já tentei indicando o Form, ocorre o mesmo erro! Também tentei adicionar junto com a criação dos TLabels, também ocorreu o mesmo erro!
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Posta sua procedure completa de criação do Label.
Pode estar criando como outra classe porque seu processo está correto.
GOSTEI 0
Novice Php

Novice Php

23/04/2015

procedure Tfrm01.Resultado(nTopIn,nLeftIn,nInicial,nFinal:integer);

var
  leftIn:integer;
  topIn:integer;
  esp_h:integer=20;
  esp_v:integer=25;
  inicial,final,x,y:integer;
  nomelbl:string;
  rotulo:TLabel;

begin
  inicial:=nInicial;
  final :=nFinal;
  leftIn:=nLeftIn;
  topIn:=nTopIn;
  for x:=inicial to final do
    begin
      leftIn:=leftIn + (((final + 1) - x) * esp_h) ;
      for y:=0 to x do
        begin
          nomelbl:='lbl'+Trim(IntToStr(x))+Trim(IntToStr(y));
          rotulo:=TLabel.Create(Self);
          With rotulo do
            begin
              Parent:=pnlTriangulo;
              Left:=leftIn;
              Top:=topIn;
              Name:=nomelbl;
              onClick:=SomarClick;
              onMouseMove:=AlterarCorMouseMove;
              Caption:=nomelbl;
              leftIn:=leftIn + (2 * esp_h);
              if (y = 0) or (y = x) then
                begin
                  text:='1';
                end
              else
                begin
                  text:=FloatToStr(Cf(x,y));
                end;
            end;
        end;
    leftIn:=nLeftIn;
    topIn:=topIn + esp_v;
    end;
end;
GOSTEI 0
Novice Php

Novice Php

23/04/2015

TLabels criados em um TPanel (pnlTriangulo)
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Cara,

Fiz um teste rápido e funcionou normalmente.

- Form1
- onShow chama a procedure Resultado()
- na procedure do label mostro o nome do componente clicado

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    pnlTriangulo: TPanel;
    procedure SomarClick(Sender: TObject);
    procedure Resultado(nTopIn,nLeftIn,nInicial,nFinal:integer);
    procedure AlterarCorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Resultado(nTopIn, nLeftIn, nInicial, nFinal: integer);
var
  leftIn:integer;
  topIn:integer;
  esp_h:integer;
  esp_v:integer;
  inicial,final,x,y:integer;
  nomelbl:string;
  rotulo:TLabel;

begin
  esp_h:=20;
  esp_v:=25;

  inicial:=nInicial;
  final :=nFinal;
  leftIn:=nLeftIn;
  topIn:=nTopIn;
  for x:=inicial to final do
    begin
      leftIn:=leftIn + (((final + 1) - x) * esp_h) ;
      for y:=0 to x do
        begin
          nomelbl:='lbl'+Trim(IntToStr(x))+Trim(IntToStr(y));
          rotulo:=TLabel.Create(Self);
          With rotulo do
            begin
              Parent:=pnlTriangulo;
              Left:=leftIn;
              Top:=topIn;
              Name:=nomelbl;
              onClick:=SomarClick;
              onMouseMove:=AlterarCorMouseMove;
              Caption:=nomelbl;
              leftIn:=leftIn + (2 * esp_h);
              if (y = 0) or (y = x) then
                begin
                  text:='1';
                end
              else
                begin
                  text:='2';   // alterado, dava erro no "cf"  text:=FloatToStr(Cf(x,y));
                end;
            end;
        end;
    leftIn:=nLeftIn;
    topIn:=topIn + esp_v;
    end;
end;

procedure TForm1.SomarClick(Sender: TObject);
begin
   ShowMessage(TLabel(Sender).Caption);
end;

procedure TForm1.AlterarCorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
// nao implementado
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Resultado(1,1,1,1);
end;

end.
GOSTEI 0
Novice Php

Novice Php

23/04/2015

cf eh uma função que retornava uma combinação dos elementos (x,y), entao so pode ser do meu Lazarus então ou do Windows, fiz o seu teste, e apresentou o mesmo erro do meu programa


[img]http://arquivo.devmedia.com.br/forum/imagem/424404-20150428-153130.jpg[/img]
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Tá com cara de bug mesmo.
Então, por desencargo, vamos tentar algo que não deveria dar problema, maaaas:

1. Declara a procedure SomarClick dentro de public

2. Na atribuição da procedure ao Label, faz sem o "with"

//1.
    procedure Resultado(nTopIn,nLeftIn,nInicial,nFinal:integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SomarClick(Sender: TObject);
    procedure AlterarCorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  end;



//2.
 rotulo.onClick:=SomarClick;
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Infelizmente a mesma coisa, apresentou o mesmo erro
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Uma luz no fim do tunel. Não programo no lazarus.
Pesquisei na internet o erro e acho que é isso

Tenta com @: 

 onClick:=@SomarClick;
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Eh porque estou começando agora, e a faculdade ensina e pede que as atividades sejam feitas no Lazarus.

Cara eh isso mesmo, muito obrigado, quebrou um galhão!

Não querendo aproveitar da sua boa vontade, mais agora tenho que fazer uma animação nesses TLabels, tipo esses Tlabels serem criados numa velocidade em que o usuario consiga acompanhar a formação deles, também mudar de cor e caption por um instante (2seg, por exemplo) e depois voltar ao original, eu consigo implementar isso nesse codigo, ou sera que preciso de uma procedure independente para fazer isso, e quais componentes eu poderia usar para fazer isso, o professor da como exemplo de uso o TTimer, mais nao consigo imaginar um jeito de utiliza-lo, desde já agradeço, e retorno a agradecer pela resposta anterior e pela atenção prestada!
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Acho que seria o Timer mesmo para você fazer o que precisa.

No componente você estipula o intervalo em milisegundos que ele irá processar (1000 seria 1seg, por exemplo).

Quando atingir este tempo, ele executa o evento onTimer.

Exemplo:

Timer
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Vou dar uma estudada nesse componente, ve se consigo implementar essa animação com ele.. Obrigado!
GOSTEI 0
Novice Php

Novice Php

23/04/2015

[img]http://arquivo.devmedia.com.br/forum/imagem/424404-20150430-225022.gif[/img]

gostaria de fazer uma animação parecida com essa, comecei a implementar essa parte abaixo, apesar de achar que não esta certo, esse seria um caminho?

procedure TfrmTriangulo.btnAnimacaoClick(Sender: TObject);

var
  ind1,ind2:integer;

begin
  for ind1:=0 to pnlTriangulo.ControlCount-1 do
    begin
      if (pnlTriangulo.Controls[ind1] is TLabel)  then
        if (pnlTriangulo.Controls[ind1] as TLabel).Caption<>'1' then
          (pnlTriangulo.Controls[ind1]as TLabel).Visible:=False;
    end;
    for ind2:=0 to pnlTriangulo.ControlCount-1 do
      begin
        if (pnlTriangulo.Controls[ind2] is TLabel) then
          if (pnlTriangulo.Controls[ind2] as TLabel).Caption<>'1' then
            (pnlTriangulo.Controls[ind2] as TLabel).Visible:=True;
            (pnlTriangulo.Controls[ind2] as TLabel).Font.Color:=clYellow;
      end;
...........


o interval esta em 2seg (mais ate ai nesse ponto, nao fez diferença visível
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

O princípio do Timer é, a cada intervalo de tempo, rodar a procedure "onTimer" dele.
Você colocou aparentemente o código num botão que irá executar de uma vez o loop.
Uma sugestão é criar as variáveis ind1 e ind2 como globais e, a cada vez que entrar no "onTimer", processar a imagem do momento.
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Entendi, mais na verdade o que eu devo fazer é, uma animação igual a essa da figura, so que usando TEdits, mudando a cor e o text, comecei utilizando a função sleep, mais no inicio ela apenas dava uma tempo e executava a ultima linha do comando, depois que acrescentei 'Application.ProcessMessages' antes do sleep() funcionou, so que , se eu usar uma funçao 'limpar campos', ou encerrar programa, qlqr coisa do genero, ele nao para, so consigo fechar o programa, forçando parada!
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Pode ser com o Sleep também.
Cria uma variável global para interromper o processo, um botão para habilitá-la quando quiser parar e, no seu loop, valida para parar quando ela for verdadeira.

private
  // variavel
  bInterromper: boolean;
.
.
.
// botao habilitando a interrupção
procedure TFrmBtnInterromperClick(Sender: TObjetc);
begin
  bInterromper := True;
end;

procedure TfrmTriangulo.btnAnimacaoClick(Sender: TObject);
var
  ind1,ind2:integer;
 
begin
  // antes de iniciar o loop, garantir que esta desabilitada a variavel
  bInterromper := False;

  for ind1:=0 to pnlTriangulo.ControlCount-1 do
    begin
      // Se for habilitada a variavel, sai do loop
      if bInterromper then
        break;

      if (pnlTriangulo.Controls[ind1] is TLabel)  then
        if (pnlTriangulo.Controls[ind1] as TLabel).Caption<>'1' then
          (pnlTriangulo.Controls[ind1]as TLabel).Visible:=False;
    end;
    for ind2:=0 to pnlTriangulo.ControlCount-1 do
      begin
        // Se for habilitada a variavel, sai do loop
        if bInterromper then
          break;

        if (pnlTriangulo.Controls[ind2] is TLabel) then
          if (pnlTriangulo.Controls[ind2] as TLabel).Caption<>'1' then
            (pnlTriangulo.Controls[ind2] as TLabel).Visible:=True;
            (pnlTriangulo.Controls[ind2] as TLabel).Font.Color:=clYellow;
      end;
GOSTEI 0
Novice Php

Novice Php

23/04/2015

desenvolvi esse codigo ate agora: mais da erro na hora 'Color:=clGreen;' / os TEdits estao num painel 'pnlAnim', todos esses TEdits que serao referenciados já estão criados e alinhados corretamente

procedure TfrmTriangulo.tmrAnimacaoTimer(Sender: TObject);

var
  nomeEdit1,nomeEdit2,nomeEdit3,temp:string;
  ind1,ind2,aux:integer;

begin
  for ind1:=0 to 5 do
    begin
      for ind2:=0 to ind1 do
        begin
          if (ind1>2) and (ind2<>ind1) then
            begin
              nomeEdit1:='txt'+Trim(IntToStr(ind1))+Trim(IntToStr(ind2));
              nomeEdit2:='txt'+Trim(IntToStr(ind1-1))+Trim(IntToStr(ind2-1));
              nomeEdit3:='txt'+Trim(IntToStr(ind1-1))+Trim(IntToStr(ind2));
              aux:=Coeficiente(ind1,ind2);
              temp:=IntToStr(Coeficiente(ind1-1,ind2-1))+'+'+IntToStr(Coeficiente(ind1-1,ind2));
              With TEdit(FindComponent(nomeEdit1)) do
                begin
                  Color:=clRed;
                  Text:=temp;
                end;
                With TEdit(FindComponent(nomeEdit2)) do
                  begin
                    Color:=clGreen;
                  end;
                  With TEdit(FindComponent(nomeEdit3)) do
                    begin
                      Color:=clGreen;
                    end;
                    sleep(1000);
                    With TEdit(FindComponent(nomeEdit1)) do
                      begin
                        Text:=IntToStr(aux);
                      end;
                      sleep(1000);
            end;
        end;
    end;
end;
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Qual a mensagem de erro ?
GOSTEI 0
Novice Php

Novice Php

23/04/2015

Ele compila corretamente e sem erros, na execução que ocorre o erro:

[img]http://arquivo.devmedia.com.br/forum/imagem/424404-20150506-102950.jpg[/img]
GOSTEI 0
Novice Php

Novice Php

23/04/2015

[img]http://arquivo.devmedia.com.br/forum/imagem/424404-20150506-103317.jpg[/img]
GOSTEI 0
Renato Rubinho

Renato Rubinho

23/04/2015

Aparentemente erro de acesso à memória ( talvez o objeto não tenha sido localizado ).

  if FindComponent(nomeEdit1) is TEdit then  // valida se existe antes de setar o valor
    With TEdit(FindComponent(nomeEdit1)) do
    begin
      Color:=clRed;
      Text:=temp;
    end;
  else
    ShowMessage(nomeEdit1 + ' não encontrado'); // coloca uma mensagem para identificar qual objeto não está sendo localizado.
GOSTEI 0
Novice Php

Novice Php

23/04/2015

descobri a erro, gracas a sua dica, quando o componente era o primeiro da linha atual, referenciava o primeiro componente da linha anterior -1 ( que no caso não existia)

Utilizando o 'FindComponent' eu posso referenciar todas de uma vez só, para no final. voltar todos os componentes cor=preto, tipo:

...
With TEdit(FindComponent('todos os TEdits')) do
  begin
    Color:=clBlack;
  end;
...
GOSTEI 1
POSTAR