Como já foi mencionado anteriormente, nem tudo são flores no TGraphicControl.
Imagine que você queira desenhar um componente que receba foco, ou que seja necessário ser parent de outros componentes. É ai que o TCustomControl entra em ação. Ele possui características muito semelhantes aos TGraphicControl, mas com algumas coisas a mais, como possuir um Handle, permitir que outros controles sejam colados dentro dele e ter foco.
Nossa implementação inicial será exatamente a mesma do TGraphicControl.
Na pasta Contain do nosso package clique com o botão direito do mouse e selecione a opção Add New -> Unit.
Salve a unit com o nome de uMukaLegendaCC.pas.
Declare uma classe herdada de TCustomControl chamada TMukaLegendaCC e sobrescreva o método Paint.
TMukaLegendaCC = class(TCustomControl)
private
public
procedure Paint; override;
end;
No método Paint adicionaremos o mesmo código utilizado na classe anterior.
procedure TMukaLegendaCC.Paint;
begin
inherited;
Canvas.Brush.Color := clSkyBlue;
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := clBlack;
Canvas.Pen.Width := 1;
Canvas.Rectangle(ClientRect);
end;
De um Build no package e instale-o novamente, o componente terá o mesmo comportamento do anterior, ou seja, não será nada além de um retângulo SkyBlue de bordas Pretas.
A diferença irá começar agora, já que estamos trabalhando com o TCustomControl e vimos que esta classe possui a capacidade de receber foco, vamos fazer com que nosso componente reaja ao foco.
Primeiro vamos alterar o nosso método paint, fazendo com que a cor do componente mude caso ele esteja “Focado”.
procedure TMukaLegendaCC.Paint;
begin
inherited;
if Focused then
begin
Canvas.Brush.Color := clRed;
end else begin
Canvas.Brush.Color := clSkyBlue;
end;
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := clBlack;
Canvas.Pen.Width := 1;
Canvas.Rectangle(ClientRect);
end;
Mas apenas isso não fará nosso componente reagir da forma desejada. Aqui apenas dissemos que caso ele esteja focado desejamos que ele fique com a cor vermelha, até então sem problemas, a não ser pelo fato do Paint não ser executado quando o componente recebe o foco. Ele só será repintado quando desaparecer e reaparecer na tela, como quando a janela é minimizada ou outra coisa aparece em cima do controle.
Bom, então faremos com que o componente seja redesenhado caso receba o Foco.
Para reagir ao foco iremos mapear a mensagem CM_FOCUSCHANGED e forçaremos a pintura do componente.
TMukaLegendaCC = class(TCustomControl)
private
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
public
procedure Paint; override;
end;
Para forçar a pintura utilizaremos o método Invalidate, e como o próprio nome já diz, ele irá invalidar o nosso controle e forçar com que ele seja redesenhado.
procedure TMukaLegendaCC.CMFocusChanged(var Message: TCMFocusChanged);
begin
inherited;
Invalidate;
end;
De um Build no package e observe que se adicionarmos nosso componente com diversos outros controles em um formulário, e formos dando Tab, o nosso controle ficará vermelho ao receber o foco.
Mas para fechar nosso novo controle com “chave de ouro” está faltando ele receber o foco caso seja clicado pelo mouse.
Para isso temos um método prontinho, basta sobrescreve-lo. Seu nome não poderia ser mais apropriado, “Click”;
TMukaLegendaCC = class(TCustomControl)
private
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
public
procedure Paint; override;
procedure Click; override;
end;
Basta sobrescrever o método e atribuir o foco do controle.
procedure TMukaLegendaCC.Click;
begin
inherited;
SetFocus;
end;
- Voilà! Agora nosso controle recebe o foco quando for clicado.
Muitas vezes, e digo, muitas vezes mesmo, temos a necessidade de criarmos um controle que tenham uma barra de rolagem. Para isso temos uma classe que se encaixa “quase” como uma luva, o TScrollingWinControl.
- Mas por que o “quase”?
Existe uma definição que diz que controles herdados de TWinControl não possuem canvas porque são pintados pelo próprio sistema operacional. Mas toda regra tem sua exceção, como é o caso do TCustomControl. O que não ocorre com o TScrollingWinControl que possui toda a implementação para utilização de barras de rolagem, mas não possui o método Paint nem a propriedade Canvas, ou seja, temos que fazer tudo na mão.
Vamos começar deixando o nosso controle funcionando da mesma forma que nosso TGraphicControl. Para isso teremos que criar todo o suporte existente no TCustomControl.
Usaremos o próprio TCustomControl como base, já que tanto ele quanto o TScrollingWinControl herdam de TWinControl.
TMukaLegendaSW = class(TScrollingWinControl)
private
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure PaintWindow(DC: HDC); override;
procedure Paint; virtual;
end;
No construtor do nosso objeto instanciaremos nossa variável FCanvas e vamos habilitar a opção DoubleBuffered.
constructor TMukaLegendaSW.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
DoubleBuffered := True;
end;
Quando o DoubleBuffered está habilitado o controle é pintado primeiro em um Bitmap em memória e depois ele renderiza a imagem na tela, do contrario o controle seria desenhado diretamente na tela. Ativando o DoubleBuffered eliminamos o “flick” que o controle pode apresentar na tela, principalmente controles que tenham barras de rolagem e precisam trabalhar com a imagens dentro deles. Claro que o custo disso é um gasto maior de memoria.
Toda vez que um controle deve ser pintado ele recebe uma mensagem do tipo WM_PAINT. Neste momento vamos interceptar a mensagem e informar ao controle que seu desenho será customizado.
procedure TCompLegendaSW.WMPaint(var Message: TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState + [csCustomPaint];
end;
Controles como o TEdit, TComboBox e TButton não possuem uma pintura customizada, eles são desenhados pelo próprio sistema operacional.
Adicionando o csCustomPaint ao ControlState o Delphi chamará o método PaintWindow quando for fazer o desenho de nosso controle (no inherited do WMPaint para ser mais exato). E é neste momento que configuramos nossa variável FCanvas e chamamos o nosso método Paint.
procedure TCompLegendaSW.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;
Primeiramente devemos travar o Canvas (FCanvas.Lock), garantindo que nenhum outro processo interfira na pintura. Depois diremos ao Canvas que ele será responsável pelo desenho do nosso controle. Para isso já temos o parâmetro DC que será atribuído à propriedade Handle do Canvas.
Obs: UpdateTextFlags atualiza possíveis mudança no controle, como em alguns casos que a escrita é feita da direita para a esquerda.
Para concluir chamamos o método Paint onde está realmente ao desenho do nosso controle.
A única necessidade real de utilizarmos um método Paint é por fins de coerência com outras classes, para manter o padrão e o encapsulamento de código, pois tudo poderia ser implementado diretamente no método PaintWindow.
procedure TMukaLegendaSW.Paint;
begin
inherited;
FCanvas.Brush.Color := clSkyBlue;
FCanvas.Brush.Style := bsSolid;
FCanvas.Pen.Color := clBlack;
FCanvas.Pen.Width := 1;
FCanvas.Rectangle(ClientRect);
end;
E por fim, no destrutor liberamos nossas variáveis globais, no caso apenas o FCanvas.
destructor TMukaLegendaSW.Destroy;
begin
FCanvas.Free;
inherited;
end;
- Que legal! Agora temos um controle que possui handle, trabalha muito bem com mensagens do Windows, recebe foco e tem suporte a barras de rolagem e que faz...
...a mesma coisa que o nosso controle herdado de TGraphicControl faz. Nada!
- Então! E as barras de rolagem? Como eu uso?
Vamos criar um componente de legenda, ele terá uma lista de Strings/Texto e ao lado de cada uma um pequeno retângulo com uma cor. A cor e o texto serão incluídas e configuradas por um collection, semelhante às colunas de um TDbGrid ou os panels de um TStatusBar.
Não iremos entrar no mérito de como funciona o collection, vamos abordar apenas alguns tópicos específicos para trabalhar com controles visuais.
Ao construir um collection começo sempre pelo item, pois a lista em si é utilizada apenas como container, então primeiro defino o que será listado.
TLegendaItem = class(TCollectionItcem)
published
property Color : TColor;
property Caption : TCaption;
end;
<Ctrl+C> no bloco de código a cima e temos a declaração padrão do Delphi para a classe TLegendaItem e é exatamente isso que queremos.
TLegendaItem = class(TCollectionItem)
private
FColor: TColor;
FCaption: TCaption;
procedure SetCaption(const Value: TCaption);
procedure SetColor(const Value: TColor);
published
property Color : TColor read FColor write SetColor;
property Caption : TCaption read FCaption write SetCaption;
end;
Só teremos duas pequenas alterações, nos métodos SetCaption e SetColor.
procedure TLegendaItem.SetCaption(const Value: TCaption);
begin
FCaption := Value;
Changed(False);
end;
procedure TLegendaItem.SetColor(const Value: TColor);
begin
FColor := Value;
Changed(False);
end;
A Chamada Changed informará ao collection que um dos seus itens foi alterado. Como teremos que redesenhar o componente a cada alteração é importante que façamos esta chamada.
Vamos agora ao nosso collection que será responsável por gerenciar nossas legendas.
TLegendas = class(TCollection)
FCompLegenda : TMukaLegendaSW;
function GetItem(Index: Integer): TLegendaItem;
procedure SetItem(Index: Integer; Value: TLegendaItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(pCompLegenda: TMukaLegendaSW);
function Add: TLegendaItem;
property Items[Index: Integer]: TLegendaItem read GetItem write SetItem;
end;
Toda a implementação abaixo é padrão para trabalhar com qualquer coleção.
function TLegendas.Add: TLegendaItem;
begin
Result := TLegendaItem(inherited Add);
end;
constructor TLegendas.Create(pCompLegenda: TMukaLegendaSW);
begin
inherited Create(TLegendaItem);
FMukaLegenda := pCompLegenda;
end;
function TLegendas.GetItem(Index: Integer): TLegendaItem;
begin
Result := TLegendaItem(inherited GetItem(Index));
end;
function TLegendas.GetOwner: TPersistent;
begin
Result := FMukaLegenda;
end;
procedure TLegendas.SetItem(Index: Integer; Value: TLegendaItem);
begin
inherited SetItem(Index, Value);
end;
Agora temos nosso collection que será responsável por manter as legendas que serão exibidas.
Declare uma propriedade nova chamada Legendas em nossa classe TMukaLegendaSW do tipo TLegendas com escopo de visibilidade “Published”.
published
property Legendas: TLegendas read FLegendas write FLegendas;
end;
Não se esqueça de criar a variável no construtor e destrui-la no destrutor.
constructor TMukaLegendaSW.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
DoubleBuffered := True;
FLegendas := TLegendas.Create(Self);
end;
destructor TMukaLegendaSW.Destroy;
begin
FCanvas.Free;
FLegendas.Free;
inherited;
end;
Se reinstalarmos o componente iremos ver que agora existe uma propriedade “Legendas” onde podemos incluir várias legendas e determinar suas cores.
- Ok. Está começando a ficar interessante, mas ainda não haverá qualquer mudança em nosso componente ao adicionarmos alguma legenda.
Tudo deve ser feito em nosso método Paint, mas antes vamos definir algumas constantes que iremos utilizar.
TMukaConst = class
const
MARGEM_TOP = 6;
LEFT_RET = 10;
RIGHT_LEG = 33;
HEIGHT_LEG = 13;
LEFT_TEXT = 37;
HEIGHT_LINHA = 18;
end;
Observe que as constantes estão dentro de uma classe, isso mantem nosso código orientado a objetos.
Vamos ao método Paint do nosso componente.
procedure TMukaLegendaSW.Paint;
var
li, lVert, lTop : integer;
begin
lVert := VertScrollBar.Position;
FCanvas.Brush.Style := bsSolid;
FCanvas.Brush.Color := Color;
FCanvas.FillRect(ClientRect);
for li := 0 to FLegendas.Count -1 do
begin
lTop := TMukaConst.MARGEM_TOP + (li * TMukaConst.HEIGHT_LINHA) - lVert;
FCanvas.Pen.Color := clBlack;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FLegendas[li].Color;
FCanvas.RoundRect(TMukaConst.LEFT_RET, lTop,
TMukaConst.RIGHT_RET, lTop + TMukaConst.HEIGHT_RET,5,5);
FCanvas.Brush.Style := bsClear;
FCanvas.TextOut(TMukaConst.LEFT_TEXT, lTop, FLegendas[li].Caption);
end;
end;
Quando nossa barra de rolagem for movimentada devemos redesenhar o conteúdo de nosso objeto na proporção da posição da barra de rolagem. Para isso pegamos o valor da propriedade Position da barra vertical de nosso controle e usamos como base de cálculo para nosso desenho.
Reinstalamos tudo e poderemos ver que as legendas já aparecem quando forem adicionadas em nosso componente. Mas ainda faltam alguns detalhes, pois as legendas só aparecem depois que damos um refresh na tela. E as barras de rolagens... Nada?
As barras só irão aparecer quando o Range das barras forem maior que a área do controle.
Precisamos então informar ao controle qual o tamanho real da área dentro dele, para isso sobrescreveremos o método update do nosso collection. O Método Update é executado sempre que incluímos ou excluímos um item da coleção, ou quando um de seus itens invoca o método Changed, como fizemos com o SetCaption e o SetColor.
TLegendas = class(TCollection)
FCompLegenda : TMukaLegendaSW;
function GetItem(Index: Integer): TLegendaItem;
procedure SetItem(Index: Integer; Value: TLegendaItem);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
constructor Create(pCompLegenda: TMukaLegendaSW);
function Add: TLegendaItem;
property Items[Index: Integer]: TLegendaItem read GetItem write SetItem;
end;
procedure TLegendas.Update(Item: TCollectionItem);
var
lLeg : integer;
begin
inherited;
lLeg := FMukaLegenda.Legendas.Count;
FMukaLegenda.VertScrollBar.Range := (lLeg * TMukaConst.HEIGHT_LINHA) +
TMukaConst.MARGEM_TOP;
FMukaLegenda.Invalidate;
end;
A propriedade Range das barras de rolagens determinam o tamanho real da área interna. Então calculamos a quantidade de legendas que teremos e atribuímos o valor ao Range da barra vertical.
Também no update chamamos o método Invalidate do nosso controle, isso fará com que o desenho do controle seja descartado pelo sistema operacional e um novo desenho seja requisitado. Esta é uma das melhores maneiras para redesenhar o controle, pois desta forma eliminamos o desenho antigo e não simplesmente pintamos um novo por cima.
Nosso controle está concluído, mas podemos adicionar mais alguns arremates.
TMukaLegendaSW = class(TScrollingWinControl)
private
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure PaintWindow(DC: HDC); override;
procedure Paint; virtual;
procedure CreateParams(var Params: TCreateParams); override;
published
property Legendas: TLegendas read FLegendas write FLegendas;
property Color;
end;
Declarando a property Color com escopo Published estaremos mostrando ela no Object Inspector, permitindo que possamos alterar a cor de fundo do controle, uma vez que já implementamos essa funcionalidade lá no método Paint.
WMNCHitTest fará com que possamos mexer nas barras de rolagem em tempo de designer.
procedure TMukaLegendaSW.WMNCHitTest(var Message: TWMNCHitTest);
begin
DefaultHandler(Message);
end;
No CreateParams podemos adicionar várias características ao nosso controle, provenientes do sistema operacional, como por exemplo, o suporte a bordas.
procedure TMukaLegendaSW.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_BORDER;
end;
-Blz, galera!
Com os passos mostrados ganhamos uma base para criarmos novos componentes visuais. Fica claro que não é necessário ser nenhum gênio para construir novos controles, mas requer tempo e um bom conhecimento da VCL.
Os códigos fontes completos podem ser baixados em http://cc.embarcadero.com/Item/28078
Abração a todos!
Connect with Us