GARANTIR DESCONTO

Fórum Função q muda a cor quando muda o foco (p/ toda a aplicacao) #309162

14/01/2006

0

Delphi

Pessoal Boa Noite,

Estou tentando fazer uma função que mude a cor de fundo dos componentes quand eles recebem o foco, mas queria fazer uma vez para usar em toda a aplicação?

Outra dúvida é como tratar a mudancao de foco pelo application Events, usando as mensagens do windows. Tem como saber quais os tipos de mensagem existentes?


Daniel_mc

Daniel_mc

Responder

Posts

14/01/2006

Edilcimar

eu uso isto em edit e maskedit, mas infelizmente até hoje não achei uma maneira de fazer para toda a aplicação, eu tenho que ir no onenter e onexit de todos os componentes de todos os forms


Responder

Gostei + 0

16/01/2006

Emerson Nascimento

atribua uma função ao evento Screen.OnActiveControlChange (procure no help do delphi sobre OnActiveControlChange).

não esqueça de atribuir um Screen.OnActiveControlChange := nil ao fechar a aplicação.


Responder

Gostei + 0

16/01/2006

Rafael Gomes

emerson, daria para explicar melhor!?

[]s


Responder

Gostei + 0

17/01/2006

Emerson Nascimento

explicar melhor? claro...

aí vai um exemplo bem completo ilustrando o uso do evento OnActiveControlChange (coloque alguns componentes no form e veja o resultado):

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, CheckLst, Mask, Grids;

type
  TMeuComponente = class(TControl)
  public
    property Color;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    CheckBox1: TCheckBox;
    Panel1: TPanel;
    ListBox1: TListBox;
    ComboBox1: TComboBox;
    StringGrid1: TStringGrid;
    MaskEdit1: TMaskEdit;
    CheckListBox1: TCheckListBox;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure FocoAlterado(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Componente: TWinControl;
  public
    { Public declarations }
  end;

const
  CorSemFoco = clWindow;
  CorComFoco = clTeal;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FocoAlterado(Sender: TObject);
begin
  if Componente <> nil then
    TMeuComponente(Componente).Color := CorSemFoco;

  if ActiveControl is TWinControl then
    try
      TMeuComponente(ActiveControl).Color := CorComFoco;
      Componente := ActiveControl;
    except
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.OnActiveControlChange := FocoAlterado;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Screen.OnActiveControlChange := nil;
end;

end.



Responder

Gostei + 0

17/01/2006

Marco Salles

emerson , bacana o codigo...

Mas eu acho que do jeito que esta declarado , se voce estiver em uma aplicação com mais de um formulário , voce tera um erro de acesso a mémoria ao chamar o segundo formulário por exemplo

P:S
No caso de Form que são declarados em [b:3dfec8cfc6]Available Forms [/b:3dfec8cfc6]no Projectos

Se o segundo form for declado No Auto Create Forms , não havera este erro , porem pelos teste s que eu fiz o código não funciona.. Teria talvez que rescreve-lo para cada formulário secundário...

Tem condiçoes de contornar isto :?: :?: :?: :?:

Muito obrigado e parabens...


Responder

Gostei + 0

17/01/2006

Titanius

[quote:29ccfdc0b1=´Marco Salles´]emerson , bacana o codigo...

Mas eu acho que do jeito que esta declarado , se voce estiver em uma aplicação com mais de um formulário , voce tera um erro de acesso a mémoria ao chamar o segundo formulário por exemplo

P:S
No caso de Form que são declarados em [b:29ccfdc0b1]Available Forms [/b:29ccfdc0b1]no Projectos

Se o segundo form for declado No Auto Create Forms , não havera este erro , porem pelos teste s que eu fiz o código não funciona.. Teria talvez que rescreve-lo para cada formulário secundário...

Tem condiçoes de contornar isto :?: :?: :?: :?:

Muito obrigado e parabens...[/quote:29ccfdc0b1]

Tenho uma parecida, que funciona com Forms MDI, talvez solucione o problema, e se alguem quiser melhorar, fique a vontade...

Type
  TControlAtivo = class(TControl);

procedure TFrmPrincipal.ColorControl(Sender: TObject);
var
 i, p, t, pp: integer;
 Panel_Ativo: TPanel;
 Page_Ativo: TPageControl;
 TabSheet_Ativo: TTabSheet;
begin
 if (Screen.FormCount > 0) and (Screen.ActiveForm <> nil) then
 begin
  for i := 0 to Screen.ActiveForm.ControlCount - 1 do
  begin
   Application.ProcessMessages;
   if (Screen.ActiveForm.Components[i] is TDBEdit) then
   begin
    if not ((Screen.ActiveForm.Components[i] as TDBEdit).Enabled) then // ou use sem o not
    begin
     (Screen.ActiveForm.Components[i] as TDBEdit).Color := clBtnFace;
     (Screen.ActiveForm.Components[i] as TDBEdit).Font.Color := clBlack;
    end;
   end;
   if (Screen.ActiveForm.Components[i] is TEdit) then
   begin
    if not ((Screen.ActiveForm.Components[i] as TEdit).Enabled) then // ou use sem o not
    begin
     (Screen.ActiveForm.Components[i] as TEdit).Color := clBtnFace;
     (Screen.ActiveForm.Components[i] as TEdit).Font.Color := clBlack;
    end;
   end;

    //Verificar Tag 1 (Preenchimento Obrigatório)
   if ((Screen.ActiveForm.Controls[i]).Tag <> 2) and ((Screen.ActiveForm.Controls[i]).Tag <> -1) then
   begin
            // Somente Fora do Panel e sem alterar o DbGrid
    if (Screen.ActiveForm.Controls[i] is TWinControl) and not (Screen.ActiveForm.Controls[i] is TPanel) and not (Screen.ActiveForm.Controls[i] is TDbGrid) and not (Screen.ActiveForm.Controls[i] is TDbRadioGroup) and not (Screen.ActiveForm.Controls[i] is TRadioGroup) and not (Screen.ActiveForm.Controls[i] is TTabbedNotebook) and not (Screen.ActiveForm.Controls[i] is TToolBar) and not (Screen.ActiveForm.Controls[i] is TJvSpeedBar) and not (Screen.ActiveForm.Controls[i] is TStatusBar) and not (Screen.ActiveForm.Controls[i] is TGroupBox) and not (Screen.ActiveForm.Controls[i] is TPageControl) and not (Screen.ActiveForm.Controls[i] is TwwDBGrid) then
    begin
     if (Screen.ActiveForm.Controls[i] as TWinControl).Focused then
      TControlAtivo(Screen.ActiveForm.Controls[i]).Color := StringToColor(´$00F0FFFF´)
     else
      TControlAtivo(Screen.ActiveForm.Controls[i]).Color := clWindow;
    end;
            // Somente Dentro do Panel e sem alterar o DbGrid
    if (Screen.ActiveForm.Controls[i] is TWinControl) and (Screen.ActiveForm.Controls[i] is TPanel) then
    begin
     Panel_Ativo := Screen.ActiveForm.Controls[i] as TPanel;
     for p := 0 to Panel_Ativo.ControlCount - 1 do
     begin
      if ((Panel_Ativo.Controls[p]).Tag <> 2) and ((Panel_Ativo.Controls[p]).Tag <> -1) then
      begin
       if (Panel_Ativo.Controls[p] is TWinControl) and not (Panel_Ativo.Controls[p] is TDbGrid) and not (Panel_Ativo.Controls[p] is TDbRadioGroup) and not (Screen.ActiveForm.Controls[i] is TToolBar) and not (Screen.ActiveForm.Controls[i] is TJvSpeedBar) and not (Screen.ActiveForm.Controls[i] is TRadioGroup) then
       begin
        if (Panel_Ativo.Controls[p] as TWinControl).Focused then
         TControlAtivo(Panel_Ativo.Controls[p]).Color := StringToColor(´$00F0FFFF´)
        else
         TControlAtivo(Panel_Ativo.Controls[p]).Color := clWindow;
       end;
      end;
     end;
    end;
            // Somente Dentro do PageControl e sem alterar o DbGrid
    if (Screen.ActiveForm.Controls[i] is TWinControl) and (Screen.ActiveForm.Controls[i] is TPageControl) then
    begin
     Page_Ativo := Screen.ActiveForm.Controls[i] as TPageControl;
     for p := 0 to Page_Ativo.ControlCount - 1 do
     begin
      Application.ProcessMessages;
      if (Page_Ativo.Controls[p] is TTabSheet) then
      begin
       TabSheet_Ativo := Page_Ativo.Controls[p] as TTabSheet;
       for t := 0 to TabSheet_Ativo.ControlCount - 1 do
       begin
        Application.ProcessMessages;
        if ((TabSheet_Ativo.Controls[t]).Tag <> 2) and ((TabSheet_Ativo.Controls[t]).Tag <> -1) then
        begin
         if (TabSheet_Ativo.Controls[t] is TWinControl) and not (TabSheet_Ativo.Controls[t] is TPanel) and not (TabSheet_Ativo.Controls[t] is TDbGrid) and not (Screen.ActiveForm.Controls[i] is TwwDBGrid) then
         begin
          if ((TabSheet_Ativo.Controls[t] as TWinControl).Focused) and ((TabSheet_Ativo.Controls[t] as TWinControl).Tag = -1) then
           TControlAtivo(TabSheet_Ativo.Controls[t]).Color := clWindow
          else
           TControlAtivo(TabSheet_Ativo.Controls[t]).Color := StringToColor(´$00F0FFFF´);
         end;
        end;
        if (TabSheet_Ativo.Controls[t] is TPanel) then
        begin
         Panel_Ativo := TabSheet_Ativo.Controls[t] as TPanel;
         for pp := 0 to Panel_Ativo.ControlCount - 1 do
         begin
          Application.ProcessMessages;
          if ((Panel_Ativo.Controls[pp]).Tag <> 2) and ((Panel_Ativo.Controls[pp]).Tag <> -1) then
          begin
           if (Panel_Ativo.Controls[pp] is TWinControl) then
           begin
            if (Panel_Ativo.Controls[pp] as TWinControl).Focused then
             TControlAtivo(Panel_Ativo.Controls[pp]).Color := StringToColor(´$00F0FFFF´)
            else
             TControlAtivo(Panel_Ativo.Controls[pp]).Color := clWindow;
           end;
          end;
         end;
        end;
       end;
      end;
     end;
    end;
   end;
  end;
 end;
end;


procedure TFrmPrincipal.FormActivate(Sender: TObject);
begin
 Screen.OnActiveControlChange := ColorControl;
end;


Ele verifica o Tag, se o Tag for maior que 2 ele nao pinta...

[]s


Responder

Gostei + 0

17/01/2006

Marco Salles

Show de codigo Titanius , bem explicado e bem abrangente.. Mas o que eu estou tentando colocar é algo teorico

Em outras palavras gostaria de entender porque se tem um erro de acesso Violado na situação onde : :arrow: :arrow: :arrow: :arrow:

Mas eu acho que do jeito que esta declarado , se voce estiver em uma aplicação com mais de um formulário , voce tera um erro de acesso a mémoria ao chamar o segundo formulário por exemplo P:S No caso de Form que são declarados em Available Forms no Projectos


teria como definir emerson.en esta procedure [b:7c05416611]FocoAlterado[/b:7c05416611] no form Principal para que ela pude-sse ser vista ao longo de todo o aplicativo , sem te-la que reescreve-la nos formularios subjacentes.
[b:7c05416611]Note que não estou falando de form MDI como colocou o Titanius[/b:7c05416611]


Responder

Gostei + 0

17/01/2006

Emerson Nascimento

sim. aí vai a versão como você deseja, Marco Salles.
a diferença está na procedure FocoAlterado. onde antes era ActiveControl, agora é Screen.ActiveForm.ActiveControl.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, CheckLst, Mask, Grids;

type
  TMeuComponente = class(TControl)
  public
    property Color;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    ComboBox1: TComboBox;
    RadioButton1: TRadioButton;
    MaskEdit1: TMaskEdit;
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure FocoAlterado(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CorSemFoco = clWindow;
  CorComFoco = clTeal;

var
  Form1: TForm1;
  Componente: TWinControl;

implementation

uses unit2;

{$R *.dfm}

procedure TForm1.FocoAlterado(Sender: TObject);
begin
  if Componente <> nil then
    try
      TMeuComponente(Componente).Color := CorSemFoco;
    except
    end;

  if Screen.ActiveForm.ActiveControl is TWinControl then
    try
      TMeuComponente(Screen.ActiveForm.ActiveControl).Color := CorComFoco;
      Componente := Screen.ActiveForm.ActiveControl;
    except
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.OnActiveControlChange := FocoAlterado;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Screen.OnActiveControlChange := nil;
end;

end.



Responder

Gostei + 0

17/01/2006

Emerson Nascimento

aqui vai uma versão mais legal. ela mantém a cor anterior do componente (notei um pequeno problema quando há radiobutton ou checkbox no form). agora é usada a variável CorAnterior no lugar da constante CorSemFoco.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, CheckLst, Mask, Grids;

type
  TMeuComponente = class(TControl)
  public
    property Color;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    ComboBox1: TComboBox;
    RadioButton1: TRadioButton;
    MaskEdit1: TMaskEdit;
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure FocoAlterado(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Componente: TWinControl;
    CorAnterior: TColor;
  public
    { Public declarations }
  end;

const
  CorSemFoco = clWindow;
  CorComFoco = clBlue;

var
  Form1: TForm1;

implementation

uses unit2;

{$R *.dfm}

procedure TForm1.FocoAlterado(Sender: TObject);
begin
  if Componente <> nil then
    try
//      TMeuComponente(Componente).Color := CorSemFoco;
      TMeuComponente(Componente).Color := CorAnterior;
    except
    end;

  if Screen.ActiveForm.ActiveControl is TWinControl then
    try
      CorAnterior := TMeuComponente(Screen.ActiveForm.ActiveControl).Color;
      TMeuComponente(Screen.ActiveForm.ActiveControl).Color := CorComFoco;
      Componente := Screen.ActiveForm.ActiveControl;
    except
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Screen.OnActiveControlChange := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.CreateForm(TForm2,Form2);
  Form2.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.OnActiveControlChange := FocoAlterado;
end;

end.



Responder

Gostei + 0

17/01/2006

Rafael Mattos

Pessoal, no meu programa eu fiz assim


unit uMudaCor; interface Uses Typinfo,Classes,Forms,SysUtils,Dialogs, Graphics, ComCtrls,DBCtrls,StdCtrls; function LeProp(Comp: TComponent; Const PropName: string): string; function AchaComponente(Nome: string; F: TForm): TComponent; procedure AtribuiProp(Comp: TComponent; Const PropName: string; Val: string); Procedure ColorControl(Sender : TObject); implementation function AchaComponente(Nome: string; F: TForm): TComponent; var i: integer; C: TComponent; begin Result := nil; Nome := UpperCase(Nome); for i := 0 to F.ComponentCount - 1 do begin C := F.Components[i]; if UpperCase(C.Name) = Nome then begin Result := C; exit; end; end; end; // Atibui propriedade ao componente, dado seu valor como string procedure AtribuiProp(Comp: TComponent; Const PropName: string; Val: string); var PInfo: PPropInfo; begin PInfo := GetPropInfo(Comp.ClassInfo, PropName); if PInfo <> nil then begin case PInfo^.Proptype^.Kind of tkInteger: SetOrdProp(Comp, PInfo, StrToInt(Val)); tkChar, tkWChar: SetOrdProp(Comp, PInfo, ord(Val[1])); tkEnumeration: SetOrdProp(Comp, PInfo, GetEnumValue(PInfo^.PropType^, Val)); tkFloat: SetFloatProp(Comp, PInfo, StrToFloat(Val)); tkString, tkLString, tkWString: SetStrProp(Comp, PInfo, Val); tkVariant: SetVariantProp(Comp, PInfo, Val); tkInt64: SetInt64Prop(Comp, PInfo, StrToInt64(Val)); else Beep; end; end else Beep; end; // Lê valor da propriedade do componente function LeProp(Comp: TComponent; Const PropName: string): string; var PInfo: PPropInfo; begin Result := ´´; PInfo := GetPropInfo(Comp.ClassInfo, PropName); if PInfo <> nil then begin case PInfo^.Proptype^.Kind of tkInteger: Result := IntToStr(GetOrdProp(Comp, PInfo)); tkChar, tkWChar: Result := char(GetOrdProp(Comp, PInfo)); tkEnumeration: Result := GetEnumName(PInfo^.PropType^, GetOrdProp(Comp, PInfo)); tkFloat: Result := FloatToStr(GetFloatProp(Comp, PInfo)); tkString, tkLString, tkWString: Result := GetStrProp(Comp, PInfo); tkVariant: GetVariantProp(Comp, PInfo); tkInt64: Result := IntToStr(GetInt64Prop(Comp, PInfo)); else Beep end; end else Beep; end; Procedure ColorControl(Sender : TObject); var Cor, CorEditFocado, CorEditDesabilitado : TColor; I: integer; begin if CorEditFocado = 0 then CorEditFocado := clBlue; if CorEditDesabilitado = 0 then CorEditDesabilitado := clMenuBar; with Screen.ActiveForm do begin for I:= 0 to ComponentCount -1 do begin // SE O O COMPONEMTE FOR UM DBLOOKBOX if (Components[I] is TDBLookupControl) then begin if ((Components[I] as TDBLookupControl).Focused) then Cor := CorEditFocado else Cor := clWindow; if not (Components[I] as TDBLookupControl).Enabled then Cor := CorEditDesabilitado; AtribuiProp(Components[I], ´Color´, IntToStr(Cor)); end; // SE O COMPONEMTE FOR UM EDIT if (Components[I] is TCustomEdit) then begin if ((Components[I] as TCustomEdit).Focused) then Cor := CorEditFocado else Cor := clWindow; if not (Components[I] as TCustomEdit).Enabled then Cor := CorEditDesabilitado; AtribuiProp(Components[I], ´Color´, IntToStr(Cor)); end; end; end; end; end.




E depois eu uso a procedure ColorControl no Formulario Principal.


unit uPrincipal; . . . . . implementation uses uMudaCor; procedure TfrmPrincipal.FormShow(Sender: TObject); begin Screen.OnActiveControlChange := ColorControl; end procedure TfrmPrincipal.FormShow(Sender: TObject); begin Screen.OnActiveControlChange := nil; end



Responder

Gostei + 0

17/01/2006

Marco Salles

Dez emerson.en . Voce como sempre muito criativo nos seus código..
Eu rasgo esse elogio porque acho que o minimo que a gente pode fazer quando alguem se compromete cordialmente a responder algumas questoes...So resta agradecer... Muito obrigado.

Mas deixa eu explicar melhor.. O Erro de acesso violado que obtive , foi porque ao colocar o Form2 Na secção Avalaible Forms eu tentei dar um ShowModal sem criar o Formulário... Descuido meu e peço desculpas :oops: :oops: :oops: :oops: :oops:


a diferença está na procedure FocoAlterado. onde antes era ActiveControl, agora é Screen.ActiveForm.ActiveControl.


ActiveControl se refere ao Formulario e Screen.ActiveForm.ActiveControl se refere ao objeto global application . Com isto realmente temos um método para todos os formulários secundários..

Valeu...


Responder

Gostei + 0

20/01/2006

Daniel_mc

Pô galera obrigado, é que ainda tenho pouca noção de orientação a objetos em Delphi, e não consegui entender direito por onde começar. Será q vcs poderiam ser mas simples pra mim?


Responder

Gostei + 0

27/01/2006

Daniel_mc

Fiz conforme o exemplo do emerson e realmente funcionou, mas tem um problema!

Iniciei o programa e abri a tela de cadastro de clientes por exemplo e a função ta funcionando direitinho, mas quando eu fecho o form e abro de novo, a função já não funciona mais.

E se eu tentar colocar na onCreate do Form de Clientes a chamada:
procedure T_CadClientes.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := _Login.FocoAlterado;
end;

e no onClose:
procedure T_CadClientes.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
Screen.OnActiveControlChange := nil;
end;
e fizer o que falei acima(abri o form, fechar e abrir novamente)ele apresenta um erro de endereco de memoria, mas funciona a função. Sabe o que pode ser :?: :?: :?: [/code]


Responder

Gostei + 0

28/01/2006

Daniel_mc

Descobri o problema que estava causando o erro acima..

Quando o form era destruido so era atribuido [b:05f0419e8e]nil[/b:05f0419e8e] ao [b:05f0419e8e]Screen.OnActiveControlChange[/b:05f0419e8e]. O problema é que...

  private
    { Private declarations }
    Componente: TWinControl;

o ´Componete´ criado na seão private continuava apontando para o ultimo controle do form
Componente := Screen.ActiveForm.ActiveControl;


ai quando eu reabria o form o ´Componente´ estava apontando para um endereço perdido.

o que eu fiz foi:

procedure TForm1.destroi;
begin
  Screen.OnActiveControlChange := nil;
  componente:=nil;
end;


criei este metodo que atribui [b:05f0419e8e]nil[/b:05f0419e8e] ao ´Componente´ e ao inves de usar no onDestroy o:
Screen.OnActiveControlChange := nil;

eu uso
destroi;


Agradeco a atencao de todos que responderam este tópico.


Responder

Gostei + 0

10/03/2006

Titanius

Só revivendo o assunto...


Aqui está dando erro de memoria... já tentei fazer o q o amigo fez e nada... alguem sabe o q pode ser?

[]s


Responder

Gostei + 0

Mais tópicos

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar