sexta-feira, 14 de janeiro de 2011

Desativando o menu de contexto padrão (em TCustomEdits)

Quando nós damos um click com o botão direito em um componente Edit (ou qualquer outro componente que permite editar como MaskEdit, Memo, DbEdit, etc.), por padrão o menu de contexto do sistema aparece com as opções para desfazer, copia, colar, etc.

Se por qualquer razão nós não queremos que este menu apareça, um modo é simplesmente pôr um Componente TPopupMenu no form e nomeia este na propriedade PopupMenu dos componentes que queremos que o menu de contexto não apareça.

Aqui está um procedimento que usa a RTI e desabilita o popup de todos os controles em um containe.

Uses TypInfo;
procedure DisablePopUp(AControl: TWinControl);
var
i : integer;
pm : TPopupMenu;
begin
pm := TPopupMenu.Create(AControl);
for i:=0 to AControl.ControlCount-1 do
if IsPublishedProp(
AControl.Controls[i],
'PopupMenu'
) then
SetObjectProp(
AControl.Controls[i],
'PopupMenu',
pm);
end;

Use assim:
DisablePopUp(Form1);
ou
DisablePopUp(Panel1);

Menus Popup No PageControl

Saiba como exibir menus popup quando o usuário clicar com o botão direito do mouse sobre as abas de um componente PageControl. Esta técnica, agrega uma funcionalidade a mais ao componente, permitindo que cada aba tenha o seu próprio menu.

Siga os passos abaixo para implementar o procedimento responsável pela exibição dos menus no PageControl:

1) Abra uma nova aplicação e insira os seguintes componentes: 1 PageControl (paleta Win32) e 2 PopupMenu (paleta Standard);

2)  Só para exemplificar, adicione duas páginas (abas) ao PageControl com os respectivos nomes "Clientes" e "Fornecedores". Ajuste os componentes de forma que fique com a aparência abaixo. Caso deseje, você pode incluir alguns componentes no interior de cada uma das abas. Isto só não foi feito aqui porque o objetivo desta dica é explorar outras características do PageControl:

3) Insira alguns itens de menu para cada componente PopupMenu, sendo que PopupMenu1 terá correspondência com a aba "Clientes" e PopupMenu2 com a aba "Fornecedores";

4) Adicione a unit CommCtrl na seção Uses da unidade e declare, na seção public, uma procedure com o nome de TabMenuPopup, da seguinte forma:

procedure TabMenuPopup(APageControl: TPageControl; X, Y: Integer);

5)  Implemente o código da procedure, desta maneira:

procedure TForm1.TabMenuPopup(APageControl: TPageControl; X, Y: Integer);
var
  hi: TTCHitTestInfo;
  TabIndex: Integer;
  p: TPoint;
begin
  hi.pt.x := X;
  hi.pt.y := Y;
  hi.flags := 0;
  TabIndex := APageControl.Perform(TCM_HITTEST, 0, longint(@hi));
  p.x := APageControl.Left + X;
  p.y := APageControl.Top + y;
  p := ClientToScreen(p);
  // Permite o uso de diferentes menus para cada aba do PageControl...
  case TabIndex of
     0: {Primeira aba...}
        PopupMenu1.Popup(P.x, P.Y);
     1: {Segunda aba...}
     PopupMenu2.Popup(P.x, P.Y);
  end;
end;

6) No evento OnMouseDown do PageControl, digite o seguinte:

procedure TForm1.PageControl1MouseDown(Sender: TObject;
        Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbRight then
      begin
          TabMenuPopup(PageControl1, X, Y);
      end;
   end;

Sobre o Dblookupcombobox

O componente DBLookupComboBox é utilizado para selecionar registros de uma tabela e gravar em outra tabela.

As propriedades necessárias para a utilização são:

DataSource - Ligar a DataSource da Tabela ao qual vai receber o valor do registro selecionado;

DataField - Ligar o campo de ligação entre as duas tabelas, ao qual vai receber o valor do registro selecionado;

ListSource - Ligar a DataSource da Tabela ao qual vai Ter o registro selecionado;

ListField - Ligar o campo que será listado quando o usuário abrir a janela para seleção do registro;

KeyField - Ligar o campo de ligação entre as duas tabelas, ao qual terá o seu valor enviado para gravação.

O campo de ligação entre as duas tabelas pode ser um campo código, pois é este campo que manterá os valores iguais entre as duas tabelas.

quinta-feira, 13 de janeiro de 2011

Como mudar a cor de fundo em linhas diferentes de texto em um TListBox

Depois de inserir um TListBox em seu form, você deve muda a propriedade Style do TListBox para lbOwnerDrawFixed. Se você não muda a propriedade Style, o evento OnDrawItem nunca vai ser chamado. Inclua o seguinte código no Evento OnDrawItem de seu TListBox:

procedure TForm1.ListBox1DrawItem
(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
myColor: TColor;
myBrush: TBrush;
begin
myBrush := TBrush.Create;
with (Control as TListBox).Canvas do
begin
if not Odd(Index) then
myColor := clSilver
else
myColor := clYellow;

myBrush.Style := bsSolid;
myBrush.Color := myColor;
Windows.FillRect(handle, Rect, myBrush.Handle);
Brush.Style := bsClear;
TextOut(Rect.Left, Rect.Top,
(Control as TListBox).Items[Index]);
MyBrush.Free;
end;
end;

Corrigindo um pequeno bug em TLabel.AutoSize

Se você mudar de fontes pequenas para fontes grandes, os tamanhos de seus rótulos não serão mudados. AutoSize só funcionará quando você mudar o caption do rótulo ou quando você acessar a propriedade AutoSize.

O seguinte código pode ser executado no evento FormCreate para corrigir os tamanhos.

for I := 0 to ComponentCount -1 do
if Components[I] is TLabel then
With TLabel(Components[I]) do
if AutoSize = True then
begin
AutoSize := False;
AutoSize := True;
end;

Efeito HotTrack em componentes Label e CheckBox

Neste exemplo, vamos aprender como criar um efeito HotTrack para componentes TLabel e TCheckBox. Este efeito está presente em muitos componentes do Delphi, em um dos caso no componente TPageControl. Ele é responsável por colorir as "guias" do PageControl quando o mouse "pousa" sobre a TabSheet.

Você deve estar se perguntando:
- Não seria o caso de criarmos um evento onMouseMove e colorirmos o mesmo através deste evento?

A resposta é sim, mas teríamos que fazer isso para todos os componentes do Form. Então para simplificarmos, vamos usar um outro método, mais genérico.
Nós vamos enviar uma mensagem ao Form fazendo com que seja disparado uma procedure que contém o algoritimo que será usado para mudar a cor da fonte dos componentes; O algoritimo é a procedure a seguir:

procedure TForm1.ChangeColor(Sender : TObject; MSG : Integer);
begin
If Sender is TLabel Then begin
   If (Msg = CM_MOUSELEAVE) Then
     (Sender as TLabel).Font.Color:=clWindowText;
   If (Msg = CM_MOUSEENTER) Then
     (Sender as TLabel).Font.Color:=clBlue;
end;
If Sender is TCheckBox then begin
   If (Msg = CM_MOUSELEAVE) Then
     (Sender as TCheckBox).Font.Color:=clWindowText;
   If (Msg = CM_MOUSEENTER) Then
     (Sender as TCheckBox).Font.Color:=clBlue;
end;
end;

E para dispara-lo vamos usar a procedure:

procedure TForm1.WndProc(Var Msg : TMessage);
var I : Integer;
begin
For I := 0 to ComponentCount -1 do
   If MSG.LParam = Longint(Components[I]) Then ChangeColor(Components[i],Msg.Msg);
inherited WndProc(Msg);
end;

Que é herdada do próprio Delphi, veja "inherited WndProc(Msg);".

Para exemplificar:
1- Abra o Delphi e no form vazio que se abre coloque alguns CheckBoxes e Labels.
2- Declare as procedures como a seguir na área private do formulário.

...
private
{ Private declarations }
   procedure ChangeColor(Sender : TObject; MSG : Integer);
   procedure WndProc(Var Msg : TMessage);override;
public
{ Public declarations }
end;
...

3- Digite seus respectivos algoritimos:

procedure TForm1.ChangeColor(Sender : TObject; MSG : Integer);
begin
If Sender is TLabel Then begin
   If (Msg = CM_MOUSELEAVE) Then
     (Sender as TLabel).Font.Color:=clWindowText;
   If (Msg = CM_MOUSEENTER) Then
     (Sender as TLabel).Font.Color:=clBlue;
end;
If Sender is TCheckBox then begin
   If (Msg = CM_MOUSELEAVE) Then
     (Sender as TCheckBox).Font.Color:=clWindowText;
   If (Msg = CM_MOUSEENTER) Then
     (Sender as TCheckBox).Font.Color:=clBlue;
end;
end;
procedure TForm1.WndProc(Var Msg : TMessage);
var I : Integer;
begin
For I := 0 to ComponentCount -1 do
   If MSG.LParam = Longint(Components[I]) Then ChangeColor(Components[i],Msg.Msg);
inherited WndProc(Msg);
end;
Pronto, agora basta compilar e ver o resultado.

Note as verificações necessárias para mudar os labels e checkboxes, isso significa que podemos fazer para outros objetos no Delphi;

If Sender is TLabel Then begin
If Sender is TCheckBox then begin

Hints para Itens de Menu

Quando o mouse passa por cima de um componente (um TButton, por exemplo) se a propriedade ShowHint for True e houver algum texto na propriedade Hint, a janela Hint/ToolTip será exibida para o componente.
Por design do Windows, mesmo se fixamos o valor da propriedade Hint para um item de Menu, o popup do Hint não será exibido. Porém, os itens de menu Iniciar exibem Hints, e o menu Favoritos do Internet Explorer também exibe hints de itens de menu.
Está bastante normal utilizar o evento OnHint da variável global Application, em aplicações Delphi, para exibir hints  (longos) de itens de menu em uma barra de estado.
O Windows não expõe as mensagens necessárias para suportar um evento OnMouseEnter tradicional.
Se quisermos adicionar hints popups de item de menu (tooltips) aos menus de aplicações Delphi, precisamos “apenas” controlar apropriadamente a mensagem WM_MenuSelect.
A classe TMenuItemHint - Hints para itens  de menu! 
Já que não podemos confiar no método Application.ActivateHint para exibir a janela de hint para itens de menu (pois o tratamento de menus é completamente controlando pelo Windows), para exibir a janela de hint, temos que criar nossa própria versão da mesma - derivando uma nova classe THintWindow.
Vejamos como criar uma classe TMenuItemHint - uma viúva de hint, que de fato é exibida para itens de menu! Em primeiro lugar, precisamos controlar a mensagem Windows WM_MENUSELECT:

type
  TForm1 = class(TForm)
  ...
  private
    procedure WMMenuSelect(var Msg: TWMMenuSelect) ; message WM_MENUSELECT;
  end
...
implementation
...
procedure TForm1.WMMenuSelect(var Msg: TWMMenuSelect) ;
var
  menuItem : TMenuItem;
  hSubMenu : HMENU;
begin
  inherited; // from TCustomForm (so that Application.Hint is assigned)

  menuItem := nil;
  if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then
  begin
    if Msg.MenuFlag and MF_POPUP = MF_POPUP then
    begin
      hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem);
      menuItem := Self.Menu.FindItem(hSubMenu, fkHandle);
    end
    else
    begin
      menuItem := Self.Menu.FindItem(Msg.IDItem, fkCommand);
    end;
  end;
  miHint.DoActivateHint(menuItem);
end; (*WMMenuSelect*)

Informação rápida: a mensagem WM_MENUSELECT é enviada para janela owner do menu (Form1!), quando o usuário seleciona (não clica!) um item de menu. Usando o método FindItem da classe TMenu, podemos obter o item de menu atualmente selecionado. Os parâmetros do FindItem tem relação com as propriedades da mensagem recebida.
Uma vez que saibamos qual o item de menu por onde o mouse está passando, chamamos o método DoActivateHint da classe TMenuItemHint.

Nota: a variável miHint está definida como “var miHint: TMenuItemHint" e é criada no tratador de evento OnCreate do Formulário.

Agora, só resta a implementar a classe TMenuItemHint. Vejamos a parte da interface:

TMenuItemHint = class(THintWindow)
private
  activeMenuItem: TMenuItem;
  showTimer: TTimer;
  hideTimer: TTimer;
  procedure HideTime(Sender: TObject);
  procedure ShowTime(Sender: TObject);
public
  constructor Create(AOwner: TComponent); override;
  procedure DoActivateHint(menuItem: TMenuItem);
  destructor Destroy; override;
end;

Basicamente, a função DoActivateHint chama o método ActivateHint do THintWindow que usa a propriedade Hint  do TMenuItem (se for designada).
O showTimer é usado para garantir que o HintPause (da Application) ocorra antes do hint ser exibido. O hideTimer usa Application.HintHidePause para esconder a janela hint depois de um intervalo especificado.
Quando usaríamos Hints de Itens de Menu ? 
Apesar de que alguém poderia dizer que não é um bom projeto para exibir hints de itens de menu, há situações onde a exibição de hints  de itens de menu, de fato é muito melhor do que usar uma barra de estado. Uma lista de itens de menus “mais recentemente usados” (Most Recently Used - MRU) é tal caso. Um menu de barra de tarefa personalizado é outro.
Crie uma nova aplicação Delphi. No formulário principal coloque um MainMenu ("Menu1") (paleta Standard), um StatusBar (paleta Win32) e um ApplicationEvents (paleta Aditional).
Acrescente vários itens de menu ao menu. Designe uma propriedade Hint para alguns itens de menu, deixe alguns itens de menu "livres" de Hint.


A seguir, o código de fonte completo da unit, junto com a implementação da classe TMenuItemHint:

unit Unit1;

interface

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


type
  TMenuItemHint = class(THintWindow)
  private
    activeMenuItem: TMenuItem;
    showTimer: TTimer;
    hideTimer: TTimer;
    procedure HideTime(Sender: TObject);
    procedure ShowTime(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure DoActivateHint(menuItem: TMenuItem) ;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
...
    procedure FormCreate(Sender: TObject) ;
    procedure ApplicationEvents1Hint(Sender: TObject);
  private
    miHint : TMenuItemHint;
    procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  miHint := TMenuItemHint.Create(self);
end; (*FormCreate*)

procedure TForm1.ApplicationEvents1Hint(Sender: TObject) ;
begin
  StatusBar1.SimpleText := 'App.OnHint : ' + Application.Hint;
end; (*Application.OnHint*)

procedure TForm1.WMMenuSelect(var Msg: TWMMenuSelect) ;
var
  menuItem: TMenuItem;
  hSubMenu: HMENU;
begin
  inherited; // from TCustomForm (ensures that Application.Hint is assigned)

  menuItem := nil;
  if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then
  begin
    if Msg.MenuFlag and MF_POPUP = MF_POPUP then
    begin
      hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem) ;
      menuItem := Self.Menu.FindItem(hSubMenu, fkHandle) ;
    end
    else
    begin
      menuItem := Self.Menu.FindItem(Msg.IDItem, fkCommand) ;
    end;
  end;

  miHint.DoActivateHint(menuItem) ;
end; (*WMMenuSelect*)


{ TMenuItemHint }
constructor TMenuItemHint.Create(AOwner: TComponent) ;
begin
inherited;
showTimer := TTimer.Create(self) ;
showTimer.Interval := Application.HintPause;

hideTimer := TTimer.Create(self) ;
hideTimer.Interval := Application.HintHidePause;
end; (*Create*)

destructor TMenuItemHint.Destroy;
begin
hideTimer.OnTimer := nil;
showTimer.OnTimer := nil;
self.ReleaseHandle;
inherited;
end; (*Destroy*)

procedure TMenuItemHint.DoActivateHint(menuItem: TMenuItem) ;
begin
//force remove of the "old" hint window
hideTime(self) ;

if (menuItem = nil) or (menuItem.Hint = '') then
begin
   activeMenuItem := nil;
   Exit;
end;

activeMenuItem := menuItem;

showTimer.OnTimer := ShowTime;
hideTimer.OnTimer := HideTime;
end; (*DoActivateHint*)

procedure TMenuItemHint.ShowTime(Sender: TObject) ;
var
r: TRect;
wdth: integer;
hght: integer;
begin
if activeMenuItem <> nil then
begin
   //position and resize
   wdth := Canvas.TextWidth(activeMenuItem.Hint) ;
   hght := Canvas.TextHeight(activeMenuItem.Hint) ;

   r.Left := Mouse.CursorPos.X + 16;
   r.Top := Mouse.CursorPos.Y + 16;
   r.Right := r.Left + wdth + 6;
   r.Bottom := r.Top + hght + 4;
    ActivateHint(r,activeMenuItem.Hint) ;
end;
  showTimer.OnTimer := nil;
end; (*ShowTime*)

procedure TMenuItemHint.HideTime(Sender: TObject) ;
begin
//hide (destroy) hint window
self.ReleaseHandle;
hideTimer.OnTimer := nil;
end; (*HideTime*)

end.