(Resolvido) Ficar Piscando O Caption Da Aba Se For Habilitado O C

[robinhocne]

Olá pessoal, estava querendo facilitar na informação para o usuário, e tenho uma aba de Observações no cadastro de alunos, e gostaria de saber se tem como se o campo de observações for preenchido se tem como a aba ficar tipo em outra cor ou piscando. mas é assim se o usuário quiser que fica assim ele clica no ChekBox para ficar como alerta.

TPageControl (TTabSheet8) aba de lançamentos

TMemo (MemObs) para as observações

TChekBox (ChekObs) para deixar em alerta.

Então seria assim se o Usuário quizesse que a aba ficasse em alerta piscando ou em outra cor clica no ChekObs, se não ai fica normal!

Gostaria de saber se tem como fazer isso ou se alguém tem alguma ideia melhor sempre é bem vinda e analizada com atenção.

Aguardo resposta.

Editado Novembro 1, 2007 por robinhocne

[robinhocne]

Fiz dessa maneira....

Aqui eu fiz colocando um Label, mas gostaria de ajuda para poder fazer no caption da aba de obsercação:

Coloquei um Timer

procedure TFrmALunos.Timer1Timer(Sender: TObject);

begin
  inherited;

 IF CheckBox1.Checked = TRUE THEN
    begin

        if ALERTA = true then
         begin
           Label1.Visible := true;
           Label1.Font.Color := clred;
           ALERTA := FALSE;

         end
        else
         begin
           Label1.Font.Color := clYellow;
           ALERTA := true;
         end;

      end;
end;

Deixei o Label como falso e depois o chekBox habilita se o usuário querer que fica piscando como alerta:

procedure TFrmALunos.CheckBox1Click(Sender: TObject);
begin
  inherited;
  if CheckBox1.Checked = true then
   begin
    timer1.Enabled := true;
    ALERTA := TRUE;
    end
  else
    begin
      timer1.Enabled := false;
      Label1.Visible := false;
    end;
end;

Aguardo ajudas.

[Walter Gazzarrini Neto]

Alterando a cor dos TabSheet de um PageControll

- Coloque um PageControll num form

- Adicione 6 TabSheet (New Page)

- Agora basta implementar o codigo abaixo

procedure TForm1.PageControl1DrawTab(Control: 

TCustomTabControl; 
TabIndex: Integer; const Rect: TRect; Active: Boolean); 
begin 
case TabIndex of 
0: Control.Canvas.Font.Color:=clgreen; 
1: Control.Canvas.Font.Color:=clred; 
2: Control.Canvas.Font.Color:=clblue; 
3: Control.Canvas.Font.Color:=clYellow; 
4: Control.Canvas.Font.Color:=clMaroon; 
5: Control.Canvas.Font.Color:=clWhite; 
end; 
Control.Canvas.TextOut(Rect.left+5,Rect.top+3,PageControl1.Pages[tabindex].Caption); 
PageControl1.Pages[TabIndex].Font.Color:=Control.Canvas.Font.Color; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
PageControl1.OwnerDraw:=true; 
end;

O problema é que não consegui conciliar isso com o CheckBox, você pode colocar o código do create no click do check box,mas quando desmarcar não acontece nada ,mas isso talvez ajude, se conseguir post aí como fez.

Abraços vlw

Voce ensina melhor aquilo que voce mais precisa aprender. (Richard Bach)

Editado Novembro 2, 2007 por Walter Gazzarrini Neto

[Walter Gazzarrini Neto]

Consegui fazer voltar ao normal faz assim:

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);

begin
case TabIndex of
0: Control.Canvas.Font.Color:=clgreen;

end;
Control.Canvas.TextOut(Rect.left+5,Rect.top+3,PageControl1.Pages[tabindex].Caption);
PageControl1.Pages[TabIndex].Font.Color:=Control.Canvas.Font.Color;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

if CheckBox1.Checked= true then
begin
PageControl1.OwnerDraw:=true;

                         end;

if CheckBox1.Checked= false then
begin
PageControl1.OwnerDraw:=false;
end;


end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
timer1.Enabled:=true;
end;

[robinhocne]

Consegui fazer voltar ao normal faz assim:

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);

begin
case TabIndex of
0: Control.Canvas.Font.Color:=clgreen;

end;
Control.Canvas.TextOut(Rect.left+5,Rect.top+3,PageControl1.Pages[tabindex].Caption);
PageControl1.Pages[TabIndex].Font.Color:=Control.Canvas.Font.Color;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

if CheckBox1.Checked= true then
begin
PageControl1.OwnerDraw:=true;

                         end;

if CheckBox1.Checked= false then
begin
PageControl1.OwnerDraw:=false;
end;


end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
timer1.Enabled:=true;
end;

Cara tá dando esse erro no TabIndex:

[Error]FAlunos.pas(217): Unknown directive: 'TabIndex' [Error] FAlunos.pas(217): '=' expected but ';' found [Error] FAlunos.pas(217): '=' expected but ';' found [Error] FAlunos.pas(220): Undeclared identifier: 'TabIndex' [Error] FAlunos.pas(221): Undeclared identifier: 'Control' [Error] FAlunos.pas(224): Missing operator or semicolon [Error] FAlunos.pas(225): Missing operator or semicolon [Error] FAlunos.pas(225): Statement expected, but expression of type 'TColor' found [Fatal Error] SistemaCfc.dpr(11): Could not compile used unit 'FAlunos.pas'

Fiz desse jeito aqui e ai ele muda O nome do Caption de Observação para Alerta, mas não estou conseguindo tipo colocar a cor nesse caption de Observação e Alerta, Alguém saberia como ?

procedure TFrmALunos.Timer1Timer(Sender: TObject);

begin
  inherited;



 IF CheckBox1.Checked = TRUE THEN
    begin

        if ALERTA = true then
         begin
           Label1.Visible := true;
           Label1.Font.Color := clred;
           ALERTA := FALSE;
           (TabSheet1.Caption := 'Observação');

         end
        else
         begin
           Label1.Font.Color := clYellow;
           ALERTA := true;
           (TabSheet1.Caption := 'Alerta');
         end;

      end;
end;

[Walter Gazzarrini Neto]

você esta pondo o código nesse evento:PageControl1DrawTab ?

Aqui no meu deu certo! , olha o código do meu 1º post ve se num tem nenhuma diferença!!!

[robinhocne]

você esta pondo o código nesse evento:PageControl1DrawTab ?

Aqui no meu deu certo! , olha o código do meu 1º post ve se num tem nenhuma diferença!!!

Fiz exatamente igual ao que você me passou mas dá erro nesse TabIndex:....

Editado Novembro 2, 2007 por robinhocne

[Churc]

Opa

Robinho veja se o cabeçalho da procedure possui a variavel TabIndex

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;

TabIndex: Integer; const Rect: TRect; Active: Boolean);

e outra coisa, porque voce ta colocando o inherited?

abraços

[robinhocne]

Opa

Robinho veja se o cabeçalho da procedure possui a variavel TabIndex

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;

TabIndex: Integer; const Rect: TRect; Active: Boolean);

e outra coisa, porque voce ta colocando o inherited?

abraços

Ok, Resolvido.

[Micheus]

Consegui fazer voltar ao normal faz assim:

...
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if CheckBox1.Checked= true then
  begin
    PageControl1.OwnerDraw:=true;
  end;
  if CheckBox1.Checked= false then
  begin
    PageControl1.OwnerDraw:=false;
  end;
end;
...

Não vamos assassinar a lógica pessoal... o trecho de código acima, continuaria claro, muito mais lógico e otimizado, desta forma abaixo:

...
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  PageControl1.OwnerDraw := CheckBox1.Checked;
end;
...

Esta explicação do Churc, pode ajudar na compreensão. ;)