 |
ActiveDelphi
.: O site do programador Delphi! :.
|
| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
JACIR
Aprendiz
Registrado: Quarta-Feira, 29 de Setembro de 2004
Mensagens: 200
Localização: Laranjeiras do Sul - PR
|
 Enviada: Ter Dez 05, 2006 8:01 pm Assunto: colorir PageControl e TabSheets |
 |
|
| Psoal, como faço para colocar cor no PageControl e TabSheets? |
|
| Voltar ao Topo |
|
 |
saobentobaixo
Novato
Registrado: Sexta-Feira, 8 de Setembro de 2006
Mensagens: 15
|
| Enviada: Qua Dez 06, 2006 4:28 pm Assunto: |
|
|
- 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; |
|
| Voltar ao Topo |
|
|
sham
Novato
Registrado: Quinta-Feira, 7 de Dezembro de 2006
Mensagens: 2
|
| Enviada: Qui Dez 07, 2006 8:30 pm Assunto: |
|
|
| Desculpem a intromissão mas eu estava procurando algo extamente assim e, funcionou perfeitamente, obrigado. |
|
| Voltar ao Topo |
|
|
JACIR
Aprendiz
Registrado: Quarta-Feira, 29 de Setembro de 2004
Mensagens: 200
Localização: Laranjeiras do Sul - PR
|
| Enviada: Sex Dez 08, 2006 10:03 am Assunto: |
|
|
| Olá, isso mudou a cor da fonte do texto, blz. Mas na verdade eu queria mudar a cor da TabSheet. mas valew esforço aí. abraço |
|
| Voltar ao Topo |
|
|
JACIR
Aprendiz
Registrado: Quarta-Feira, 29 de Setembro de 2004
Mensagens: 200
Localização: Laranjeiras do Sul - PR
|
| Enviada: Seg Dez 11, 2006 7:01 pm Assunto: |
|
|
| Alguém sabe como colorir o objeto tabsheet??? com o código acima coloriu apenas o texto contido nela. abraço |
|
| Voltar ao Topo |
|
|
saobentobaixo
Novato
Registrado: Sexta-Feira, 8 de Setembro de 2006
Mensagens: 15
|
| Enviada: Ter Dez 12, 2006 9:45 am Assunto: |
|
|
- 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.Brush.Color:=clgreen;
1: Control.Canvas.Brush.Color:=clred;
2: Control.Canvas.Brush.Color:=clblue;
3: Control.Canvas.Brush.Color:=clYellow;
4: Control.Canvas.Brush.Color:=clMaroon;
5: Control.Canvas.Brush.Color:=clWhite;
end;
Control.Canvas.TextOut(Rect.left+5,Rect.top+3,PageControl1.Pages[tabindex].Caption);
PageControl1.Pages[TabIndex].Brush.Color:=Control.Canvas.Brush.Color;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.OwnerDraw:=true;
end;
ve se é isso que vc queria |
|
| Voltar ao Topo |
|
|
JACIR
Aprendiz
Registrado: Quarta-Feira, 29 de Setembro de 2004
Mensagens: 200
Localização: Laranjeiras do Sul - PR
|
| Enviada: Ter Dez 12, 2006 11:16 am Assunto: |
|
|
 blz kra!!! era isso mesmo!!!!! valew, abraço!!!!!!!!!! |
|
| Voltar ao Topo |
|
|
profwtelles
Novato
Registrado: Quinta-Feira, 13 de Abril de 2017
Mensagens: 1
|
| Enviada: Qui Abr 13, 2017 1:30 pm Assunto: Se houver problemas |
|
|
O conteúdo acima deu problema no Delphi 7 com Windows 10, mas a solução é criar uma Unit VCLFixes e depois adicionar ao Uses do seu programa.
| Código: | unit VCLFixes;
interface
implementation
uses
Messages, Windows, Controls, Dialogs;
// WMDrawItem fails under WOW64, see http://qc.codegear.com/wc/qcmain.aspx?d=19859
{$IFDEF VER150} // Delphi7
function GetMethodAddress(AMessageID: Word; AClass: TClass; out MethodAddr: Pointer): Boolean;
var
DynamicTableAddress: Pointer;
MethodEntry: ^Pointer;
MessageHandlerList: PWord;
EntryCount, EntryIndex: Word;
begin
Result := False;
DynamicTableAddress := Pointer(PInteger(Integer(AClass) + vmtDynamicTable)^);
MessageHandlerList := PWord(DynamicTableAddress);
EntryCount := MessageHandlerList^;
if EntryCount > 0 then
for EntryIndex := EntryCount - 1 downto 0 do begin
Inc(MessageHandlerList);
if (MessageHandlerList^ = AMessageID) then begin
Inc(MessageHandlerList);
MethodEntry := Pointer(Integer(MessageHandlerList) + 2 * (2 * EntryCount - EntryIndex) - 4);
MethodAddr := MethodEntry^;
Result := True;
end;
end;
end;
function PatchInstructionByte(MethodAddress: Pointer; ExpectedOffset: Cardinal;
ExpectedValue: Byte; NewValue: Byte): Boolean;
var
BytePtr: PByte;
OldProtect: Cardinal;
begin
Result := False;
BytePtr := PByte(Cardinal(MethodAddress) + ExpectedOffset);
if BytePtr^ = NewValue then
begin
Result := True;
Exit;
end;
if BytePtr^ <> ExpectedValue then
Exit;
if VirtualProtect(BytePtr, SizeOf(BytePtr^), PAGE_EXECUTE_READWRITE, OldProtect) then
begin
try
BytePtr^ := NewValue;
Result := True;
finally
Result := Result
and VirtualProtect(BytePtr, SizeOf(BytePtr^), OldProtect, OldProtect)
and FlushInstructionCache(GetCurrentProcess, BytePtr, SizeOf(BytePtr^));
end;
end;
end;
function PatchInstructionBytes(MethodAddress: Pointer; ExpectedOffset: Cardinal;
const ExpectedValues: array of Byte; const NewValues: array of Byte;
const PatchedValues: array of Byte): Boolean;
var
BytePtr, TestPtr: PByte;
OldProtect, Index, PatchSize: Cardinal;
begin
BytePtr := PByte(Cardinal(MethodAddress) + ExpectedOffset);
Result := True;
TestPtr := BytePtr;
for Index := Low(PatchedValues) to High(PatchedValues) do
begin
if TestPtr^ <> PatchedValues[Index] then
begin
Result := False;
Break;
end;
Inc(TestPtr);
end;
if Result then
Exit;
Result := True;
TestPtr := BytePtr;
for Index := Low(ExpectedValues) to High(ExpectedValues) do
begin
if TestPtr^ <> ExpectedValues[Index] then
begin
Result := False;
Exit;
end;
Inc(TestPtr);
end;
PatchSize := Length(NewValues) * SizeOf(Byte);
if VirtualProtect(BytePtr, PatchSize, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
try
TestPtr := BytePtr;
for Index := Low(NewValues) to High(NewValues) do
begin
TestPtr^ := NewValues[Index];
Inc(TestPtr);
end;
Result := True;
finally
Result := Result
and VirtualProtect(BytePtr, PatchSize, OldProtect, OldProtect)
and FlushInstructionCache(GetCurrentProcess, BytePtr, PatchSize);
end;
end;
end;
procedure PatchWinControl;
var
MethodAddress: Pointer;
begin
if not GetMethodAddress(WM_DRAWITEM, TWinControl, MethodAddress) then begin
ShowMessage('Cannot find WM_DRAWITEM handler in TWinControl');
Exit;
end;
if (not PatchInstructionByte(MethodAddress, 13, $4, $14)) // release and package
and (not PatchInstructionByte(MethodAddress, 23, $4, $14)) then // debug
ShowMessage('Cannot patch WM_DRAWITEM');
if not GetMethodAddress(WM_COMPAREITEM, TWinControl, MethodAddress) then begin
ShowMessage('Cannot find WM_COMPAREITEM handler in TWinControl');
Exit;
end;
if (not PatchInstructionByte(MethodAddress, 13, $04, $8)) // release and package
and (not PatchInstructionByte(MethodAddress, 23, $04, $8)) then // debug
ShowMessage('Cannot patch WM_COMPAREITEM handler');
if not GetMethodAddress(WM_DELETEITEM, TWinControl, MethodAddress) then begin
ShowMessage('Cannot find WM_DELETEITEM handler in TWinControl');
Exit;
end;
if (not PatchInstructionByte(MethodAddress, 13, $04, $0C)) // release and package
and (not PatchInstructionByte(MethodAddress, 23, $04, $0C)) then // debug
ShowMessage('Cannot patch WM_DELETEITEM handler');
if not GetMethodAddress(WM_MEASUREITEM, TWinControl, MethodAddress) then begin
ShowMessage('Cannot find WM_MEASUREITEM handler in TWinControl');
Exit;
end;
if (not PatchInstructionBytes(MethodAddress, 10, [$08, $8B], [$04, $90, $90, $90], [$04, $E8])) // release and package
and (not PatchInstructionBytes(MethodAddress, 20, [$08, $8B], [$04, $90, $90, $90], [$04, $E8])) then // debug
ShowMessage('Cannot patch WM_MEASUREITEM handler');
end;
{$ENDIF}
// end of "WMDrawItem fails under WOW64" patch
initialization
{$IFDEF VER150} // Delphi7
PatchWinControl;
{$ENDIF}
end. |
|
|
| Voltar ao Topo |
|
|
lokasso
Aprendiz
Registrado: Terça-Feira, 11 de Abril de 2017
Mensagens: 174
|
| Enviada: Sex Abr 14, 2017 2:16 pm Assunto: |
|
|
| Tem um jeito mais facil, na própriedade Style do PageControl coloque tsFlatButton, o PageControl irá ficar com a cor padrão do Form |
|
| Voltar ao Topo |
|
|
|
|
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.
|
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
