[resolvido] Barra De Rolagem

[robinhocne]

Olá pessoal,

Qual procedimento que posso fazer para que a rodinha do mouse possa rolar a barra de rolagem de um grid?

[Micheus]

Qual procedimento que posso fazer para que a rodinha do mouse possa rolar a barra de rolagem de um grid?

dê uma olhada neste tutorial (seção Tutoriais & Dicas), onde também é explicado o uso da mensagem WM_MOUSEWHEEL. Localize o texto "Vamos ao código".

Voce codifica AppEventsMessage e sua inicialização em FormCreate, no seu form principal e o efeito irá ser aplicado a todos os Grids, Memos,... componentes que façam uso do scroll.

Veja se você consegue implementar em seu código.

[robinhocne]

O procedimento AppEventsMessage foi declarado na sessão private do form CadTesteDBEdit e tem como objetivo simular o uso das teclas "para cima" e "para baixo" quando a rodinha do mouse for movimentada nestes sentidos.

- Este evento (como implementada sua chamada) deve ser implementado/atribuído à Application.OnMessage apenas no form principal da aplicação (não repetir em cada form).

CODE

procedure TCadTesteDBEdit.AppEventsMessage(var Msg: TMsg; var Handled: Boolean);

var

Sentido: SmallInt;

begin

if Msg.message = WM_MOUSEWHEEL then

begin

Msg.message := WM_KEYDOWN;

Msg.lParam := 0;

Sentido := HiWord(Msg.wParam);

if Sentido > 0 then

Msg.wParam := VK_UP

else

Msg.wParam := VK_DOWN;

end;

end;

Utilizei isso e a rodinha do mouse não funciona, só as teclas.

[Micheus]

O procedimento AppEventsMessage foi declarado na sessão private do form CadTesteDBEdit e tem como objetivo simular o uso das teclas "para cima" e "para baixo" quando a rodinha do mouse for movimentada nestes sentidos.

- Este evento (como implementada sua chamada) deve ser implementado/atribuído à Application.OnMessage apenas no form principal da aplicação (não repetir em cada form).

procedure TCadTesteDBEdit.AppEventsMessage(var Msg: TMsg; var Handled: Boolean);
var
  Sentido: SmallInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
    Msg.message := WM_KEYDOWN;
    Msg.lParam := 0;
    Sentido := HiWord(Msg.wParam);
    if Sentido > 0 then
      Msg.wParam := VK_UP
    else
      Msg.wParam := VK_DOWN;
  end;
end;

Utilizei isso e a rodinha do mouse não funciona, só as teclas.

Voce codifica AppEventsMessage e sua inicialização em FormCreate, no seu form principal e o efeito irá ser aplicado a todos os Grids, Memos,... componentes que façam uso do scroll.

acho que você não leu a segunda parte do meu comentário. No OnCreate do seu form principal (deve ser o mesmo form em que você colocou o código acima) você terá que fazer a atribuição do procedimento ao evento OnMessage:

procedure TCadTesteDBEdit.FormCreate(Sender: TObject);
begin
// declara um tratador de eventos para a aplicação
// com o objetivo de tratar o evento MouseWheel
  Application.OnMessage := AppEventsMessage;  // *** <================== AQUI
end;

[robinhocne]

Ok, Micheus deu certo, mas no formulário até os edits dá para você movimentar pelo o mouse, tem como deixar isso só focado para o grid.

[Micheus]

Ok, Micheus deu certo, mas no formulário até os edits dá para você movimentar pelo o mouse, tem como deixar isso só focado para o grid.

Bom, como está implementado (no form principal) e pelo fato de a mensagem (TMessage) recebida no evento OnMessage só temos o handle da janela, a saída seria definir este procedimento apenas no form onde tem o Grid onde você quer utilizar o recurso.

Então, você teria que colocar o procedimento AppEventsMessage no form desejado, atribuí-lo ao evento da aplicação no OnCreate deste form, bem com removê-lo no OnDestroy. Tem também que fazer o teste para saber se a janela que enviou a mensagem é o grid:

type
  TFormComOGrid = class(TForm)
  private
    procedure AppEventsMessage(var Msg: TMsg; var Handled: Boolean);
  end;
...

procedure TFormComOGrid.AppEventsMessage(var Msg: TMsg; var Handled: Boolean);
var
  Sentido: SmallInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
    if Msg.hwnd = DBGrid1.Handle then   // *** <=== AQUI você testa o handle do DBGRID em questão
    begin
      Msg.message := WM_KEYDOWN;
      Msg.lParam := 0;
      Sentido := HiWord(Msg.wParam);
      if Sentido > 0 then
        Msg.wParam := VK_UP
      else
        Msg.wParam := VK_DOWN;
    end;
end;

procedure TFormComOGrid.FormCreate(Sender: TObject);
begin
  ...
  Application.OnMessage := AppEventsMessage;  // *** <==== AQUI
end;

procedure TFormComOGrid.FormDestroy(Sender: TObject);
begin
  Application.OnMessage := nil;  // *** <==== AQUI
  ...
end;

=============================== robinhocne, me ocorreu uma segunda forma de contornar o seu problema, e bem mais simples. (não removi a resposta anterior porque pode servir a alguém) Na situação atual (aquele em que você diz que até os edit's estão "rolando") você faz apenas as seguintes alterações:

procedure TCadTesteDBEdit.AppEventsMessage(var Msg: TMsg; var Handled: Boolean);
var
  Sentido: SmallInt;
  WndClass :array[0..128] of char;                          // ***** <==== INCLUI ESTA LINHA
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin                                                     // ***** <==== INCLUI ESTA LINHA
    GetClassName(Msg.hwnd, WndClass, SizeOf(WndClass)-1);   // ***** <==== INCLUI ESTA LINHA
    if StrComp(WndClass, 'TDBGrid') = 0 then                // ***** <==== INCLUI ESTA LINHA
    begin
      Msg.message := WM_KEYDOWN;
      Msg.lParam := 0;
      Sentido := HiWord(Msg.wParam);
      if Sentido > 0 then
        Msg.wParam := VK_UP
      else
        Msg.wParam := VK_DOWN;
    end;
  end;                                                      // ***** <==== INCLUI ESTA LINHA

[robinhocne]

Ok, Micheus obrigado pela atenção mais um problema resolvido.