Jump to content
Fórum Script Brasil
  • 0

[resolvido] Barra De Rolagem


robinhocne
 Share

Question

6 answers to this question

Recommended Posts

  • 0
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.

Link to comment
Share on other sites

  • 0
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.

Link to comment
Share on other sites

  • 0
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;

Link to comment
Share on other sites

  • 0
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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      150.1k
    • Total Posts
      647.1k
×
×
  • Create New...