Scroll en DBGrid

[ecfisa]

Hola marcial.

Primero que nada, me alegro que el código te haya servido como base .

Ahora que veo que deseas un scroll continuo con retraso de tiempo, te pongo otra alternativa más simple:

Código Delphi [-]
procedure TForm1.MMouseEvent(var Msg: TMsg; var Handled: Boolean);
var
  P: TPoint;
  WControl: TWinControl;
  G: TDBGrid;
  ZD: Integer;
begin
  WControl:= FindVCLWindow(Mouse.CursorPos);
  if Assigned(WControl) and (WControl is TDBGrid) then
  begin
    P:= ScreenToClient(Mouse.CursorPos);
    G:= TDBGRid(WControl);
    ZD:=  GetSystemMetrics(SM_CXVSCROLL);
    while (P.X >= G.Left) and (P.X <= G.Left+ZD) do
    begin
      P:= ScreenToClient(Mouse.CursorPos);
      SendMessage(G.Handle, WM_HSCROLL, SB_LINELEFT, 0);
      Sleep(250);
    end;
    while (P.X >= G.Left+G.Width-ZD) and (P.X <= G.Left+G.Width) do
    begin
      P:= ScreenToClient(Mouse.CursorPos);
      SendMessage(G.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
      Sleep(250);
    end;
  end;
end;

Saludos.

[marcial]

Muchas gracias. Como siempre, mejor que el mio.

[ecfisa]

Empezado por marcial

Muchas gracias. Como siempre, mejor que el mio.

Hola.

Yo no diría mejor... sólo un modo diferente que dá un código más simple.

Saludos.

[lmpadron]

Saludos ecfisa, podría traducir este código a c usted o alguien mas? Seria magnífico !!!

[ecfisa]

Empezado por lmpadron

Saludos ecfisa, podría traducir este código a c usted o alguien mas? Seria magnífico !!!

Hola impadrón.

void __fastcall TForm1::MMouseEvent(TMsg &msg, bool &Handled){
TPoint tp;
int i;
  TWinControl *wc =  FindVCLWindow(Mouse->CursorPos);
  if (wc != NULL) {
    tp = Form1->ScreenToClient(Mouse->CursorPos);
    TDBGrid *g = static_cast<TDBGrid*> (wc);
    int ZD = GetSystemMetrics(SM_CXVSCROLL);
    while(tp.x >= g->Left && tp.x <= g->Left+ZD) {
      tp = Form1->ScreenToClient(Mouse->CursorPos);
      SendMessage(g->Handle, WM_HSCROLL, SB_LINELEFT, 0);
      Sleep(250);
    };
    while (tp.x >= g->Left+g->Width-ZD && tp.x <= g->Left+g->Width) {
      tp = Form1->ScreenToClient(Mouse->CursorPos);
      SendMessage(g->Handle, WM_HSCROLL, SB_LINERIGHT, 0);
      Sleep(250);
    };
  }
};

void __fastcall TForm1::FormCreate(TObject *Sender)
{
  Application->OnMessage = MMouseEvent;
}

Saludos.

PD: No me trates de usted. (la próxima vez que lo hagas te traduzco a Visual Basic )

[marcial]

Hola de nuevo:
Parece que la felicidad nunca es completa.
Resulta que aplico el código y va perfectamente pero....cuando en el programa existe un componente Application Event para controlar la rueda del ratón con este código en el evento On Message:

Código Delphi [-]
 if Msg.message = WM_MOUSEWHEEL then
   begin
     Msg.message := WM_KEYDOWN;
     Msg.lParam := 0;
     if Msg.wParam > 0 then
       Msg.wParam := VK_UP
     else
       Msg.wParam := VK_DOWN;
     Handled := False;
   end;

Resulta que el maravilloso código de ecfisa no funciona.

¿Habría alguna manera de poder utilizar los dos a la vez?

[marcial]

Vaya, si que se puede. Lo dejo por si a alguien le interesa:

En las Private Declarations

Código Delphi [-]
    { Private declarations }
    procedure DBGrid1PillaLaRueda(var Message: TMessage);
       procedure MMouseEvent(var Msg: TMsg; var Handled: Boolean); {SCROLL DEL DBGRID}

Despues de los Uses y antes de {SR *.DFM}

Código Delphi [-]
type
TomaInvento = class(TControl);

El el OnCreate de la Form

Código Delphi [-]
DBGrid1.WindowProc := DBGrid1PillaLaRueda;
   Application.OnMessage := MMouseEvent; {PARA EL SCROLL DEL DBGRID}

El procedure del Scroll Vertical

Código Delphi [-]
procedure TForm3.DBGrid1PillaLaRueda(var Message: TMessage);
 var
   Cuanto : short;
 begin

   if (Message.Msg = WM_MOUSEWHEEL) then begin
     Cuanto:=HIWORD(Message.WParam);
     Cuanto:=Cuanto div 120;
     DbGrid1.DataSource.DataSet.MoveBy(-Cuanto);

   end else TomaInvento(DBGrid1).WndProc(Message);
 end;

Y por último, después del procedure Vertical, el procedure de Ecfisa para el Scroll Horizontal

Así tenemos los Scroll Vertical y Horizontal sin usar las Barras de Desplazamiento

Muchas gracias